perm filename EUR[AM,DBL]2 blob
sn#572317 filedate 1981-03-20 generic text, type T, neo UTF8
(FILECREATED "20-Mar-81 17:30:20" <CSD.LENAT>EUR..7 132582
changes to: Verbosity ZZ (H14 English) (H14 ThenPrintToUser) (H14 ThenDefineNewConcepts) (H13 English) (H13 ThenPrintToUser)
(H13 ThenCompute) (H13 ThenDefineNewConcepts) (HAvoid3 English) (HAvoid3 Abbrev) (HAvoid3 IfAboutToWorkOnTask) (HAvoid3
ThenPrintToUser) (HAvoid2 English) (HAvoid2 Abbrev) (HAvoid2 IfAboutToWorkOnTask) (HAvoid2 ThenPrintToUser) (HAvoid2
ThenDeleteOldConcepts) (HAvoid IfAboutToWorkOnTask) (H12 ThenPrintToUser) (H3 ThenAddToAgenda) (H5 ThenAddToAgenda) (H14
ThenCompute) (H12 ThenDefineNewConcepts)
previous date: "20-Mar-81 01:06:33" <CSD.LENAT>EUR..6)
(PRETTYCOMPRINT EURCOMS)
(RPAQQ EURCOMS [(VARS * EURVARS)
(FNS * EURFNS)
(PROP ALL * Units)
[P (ADVISE (QUOTE EDITP)
(QUOTE BEFORE)
(QUOTE (OR (STKPOS (QUOTE EU))
(PRIN1 "
WARNING: ARE YOU SURE YOU REALLY DON'T MEAN 'EU' ??? !!! "]
[P (ADVISE (QUOTE MAKEFILE)
(QUOTE BEFORE)
(QUOTE (CheckElim]
(GLOBALVARS AbortTask? Agenda AreUnits CRLF CSlot CSlotSibs CTask Conjectures CreditTo Creditors CurPri CurReasons
CurSlot CurSup CurUnit DeletedUnits ESYSPROPS EditpTemp GCredit GSlot HaveGenl HaveSpec HeuristicAgenda
Interp LastEdited MapCycleTime MinPri NUnitSlots NeedGenl NeedSpec NewU NewUnit NewUnits NewValue NotForReal
OldValue PosCred RArrow SYSPROPS SlotToChange SlotsToChange SlotsToElimInitially Slots TTY TaskNum UDiff
Units UnusedSlots UsedSlots UserImpatience Verbosity WarnSlots conjec cprintmp)
(P (SETQ SYSPROPS (UNION ESYSPROPS SYSPROPS)))
(P (InitializeEurisko))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA EU)
(NLAML)
(LAMA CPRIN1])
(RPAQQ EURVARS (Agenda CRLF Conjectures DeletedUnits ESYSPROPS GFNS Interp MinPri NotForReal NUnitSlots NewU RArrow Slots
SlotsToElimInitially TAB Units UnusedSlots UsedSlots UserImpatience Verbosity ZZ (FONTCHANGEFLG)
(CHANGESARRAY)))
(RPAQQ Agenda NIL)
(RPAQQ CRLF "
")
(RPAQQ Conjectures NIL)
(RPAQQ DeletedUnits NIL)
(RPAQQ ESYSPROPS (ALTOMACRO BYTEMACRO SOPVAL OPCODE))
(RPAQQ GFNS (AverageWorths Check2AfterEditp CreateUnit DefineSlot HasHighWorth InitializeEurisko Interp1 Interp2 KillUnit NU
REM1PROP RunAlg START TrueIfItExists UnionProp Unitp WorkOnTask WorkOnUnit XeqIfItExists))
(RPAQQ Interp Interp2)
(RPAQQ MinPri 150)
(RPAQQ NotForReal NIL)
(RPAQQ NUnitSlots NIL)
(RPAQQ NewU NIL)
(RPAQQ RArrow ->)
(RPAQQ Slots (Abbrev Abbrev-1 Abbrev-2 Alg ApplicGenerator Applics Arity CompiledDefn Creditors DataType Defn DirectApplics
Domain DontCopy DoubleCheck ElimSlots English English-1 English-2 English-3 Examples FastAlg FastDefn Format
Generalizations Generator IfAboutToWorkOnTask IfFinishedWorkingOnTask IfParts IfPotentiallyRelevant
IfTaskParts IfTrulyRelevant IfWorkingOnTask InDomainOf IndirectApplics Inverse IsA IsRangeOf IterativeAlg
IterativeDefn NonExamples Range RecursiveAlg RecursiveDefn SibSlots Specializations SubSlots SuperSlots
ThenAddToAgenda ThenCompute ThenConjecture ThenDefineNewConcepts ThenDeleteOldConcepts ThenModifySlots
ThenParts ThenPrintToUser ToDelete ToDelete1 Transpose UnitizedAlg UnitizedDefn Worth Worth-1 Worth-2))
(RPAQQ SlotsToElimInitially NIL)
(RPAQQ TAB " ")
(RPAQQ Units (H14 H13 HAvoid3 HAvoid2 HAvoid H12 HindSightRule NonCriterialSlot H2 ThenDeleteOldConcepts TheFirstOf TheSecondOf
OR AND Abbrev Add Alg Anything ApplicGenerator Applics Arity BestChoose BestSubset Bit CompiledDefn Conjecture
Creditors CriterialSlot DataType Defn DirectApplics DivisorsOf Domain DontCopy DoubleCheck EQ EQUAL ElimSlots
English EvenNum Examples FastAlg FastDefn Format Generalizations Generator GoodChoose GoodSubset H1 H10 H11 H3
H4 H5 H6 H7 H8 H9 Heuristic IEQP IGEQ IGREATERP ILEQ ILESSP IfAboutToWorkOnTask IfFinishedWorkingOnTask IfParts
IfPotentiallyRelevant IfTaskParts IfTrulyRelevant IfWorkingOnTask InDomainOf IndirectApplics Inverse IsA
IsRangeOf IterativeAlg IterativeDefn MathConcept MathObj MathOp MathPred Multiply NNumber NonExamples NumOp
OddNum Op PerfNum PerfSquare Pred PrimeNum ProtoConjec RandomChoose RandomSubset Range RecursiveAlg
RecursiveDefn ReprConcept Set SetOfNumbers SetOp SibSlots Slot Specializations Square SubSlots Successor
SuperSlots Task ThenAddToAgenda ThenCompute ThenConjecture ThenDefineNewConcepts ThenModifySlots ThenParts
ThenPrintToUser ToDelete ToDelete1 Transpose Unit UnitOp UnitizedAlg UnitizedDefn Worth los1 los2 los3 los4
los5 los6 los7 win1))
(RPAQQ UnusedSlots (Abbrev-2 Alg ApplicGenerator CompiledDefn Defn DirectApplics English-1 English-2 English-3 IfParts
IfTaskParts IndirectApplics SibSlots ThenModifySlots ThenParts ToDelete Worth-1 Worth-2))
(RPAQQ UsedSlots (Abbrev Abbrev-1 Applics Arity Creditors DataType Domain DontCopy DoubleCheck ElimSlots English Examples FastAlg
FastDefn Format Generalizations Generator IfAboutToWorkOnTask IfFinishedWorkingOnTask
IfPotentiallyRelevant IfTrulyRelevant IfWorkingOnTask InDomainOf Inverse IsA IsRangeOf IterativeAlg
IterativeDefn NonExamples Range RecursiveAlg RecursiveDefn Specializations SubSlots SuperSlots
ThenAddToAgenda ThenCompute ThenConjecture ThenDefineNewConcepts ThenDeleteOldConcepts ThenPrintToUser
ToDelete1 Transpose UnitizedAlg UnitizedDefn Worth))
(RPAQQ UserImpatience 30)
(RPAQQ Verbosity 16)
(RPAQQ ZZ [LAMBDA (U)
(SOME [CAR (LAST (CAR (SOME (Applics (CAR (Creditors U)))
(FUNCTION (LAMBDA (A)
(MEMB U (CADR A]
(FUNCTION (LAMBDA (Z)
(AND (EQ (CADR Z)
RArrow)
(EQ (CAR Z)
(QUOTE CFrom])
(RPAQ FONTCHANGEFLG NIL)
(RPAQ CHANGESARRAY NIL)
(RPAQQ EURFNS (APPLYEVAL AddInv AddPropL Alg ApplicArgs ApplicGenArgs ApplicGenBuild ApplicGenInit Apply-to-u ApplyRule Average
AverageWorths BestChoose BestSubset CPRIN1 Certainty Check2AfterEditp CheckAfterEditp CheckElim
CheckTheValues Comp CreateUnit CurSup CycleThruAgenda Date2 DecrementCreditAssignment DefineSlot Defn
DirectApplics Divides DreplaceGet DwimUnionProp EU Eurisko ExtractInput ExtractOutput ExtractPriority
ExtractReasons ExtractSlotName ExtractUnitName Flatten FractionOf GenArgs GenBuild GenInit
Generalizations Generalize1LispFn Generalize1LispPred GeneralizeIOPair GeneralizeLispFn
GeneralizeLispPred GoodChoose GoodSubset Half HasHighWorth ISQRT IndirectApplics InitialElimSlots
InitializeCreditAssignment InitializeEurisko InsideOf Instances Interp1 Interp2 Interrupts IsAKindOf
KillSlot KillUnit KnownApplic LessWorth ListifyIfNec ListsStarting ListsStartingAux MAPAPPEND MAXIMUM
Map&Print MapApplics MapExamples MapUnion MergeProps MergeTasks NU NUnitp NearnessTo NewNam NoRepeatsIn
OrderTasks Percentify PunishSeverely Quoted REM1PROP RandomChoose RandomP RandomSubset RandomSubst
RandomSubst* ResetPri RunAlg RunDefn SOME1 SOS SQUARE START SelfIntersect SetDiff SetIntersect SibSlots
SlotNames SlotSubst Slotp SomeUneliminated SortByWorths Specializations Specialize1LispExpr
Specialize1LispFn Specialize1LispPred SpecializeBit SpecializeCompiledLispCode SpecializeDataType
SpecializeIOPair SpecializeLispFn SpecializeLispPred SpecializeList SpecializeNIL SpecializeNumber
SpecializeSlot SpecializeText SpecializeUnit StrongUnsaveDef TakingTooLong TheFirstOf TheSecondOf
TinyReward TrueIfItExists UnGet UnionProp Unitp WaxOn WholeTask WorkOnTask WorkOnUnit WorthWorkingOn
XeqIfItExists YesNo))
(DEFINEQ
(APPLYEVAL
[LAMBDA (F ARGL) (* edited: " 4-MAR-81 12:43")
(EVAL (CONS F ARGL])
(AddInv
[LAMBDA (un)
(* edited: "27-Feb-81 19:40")
(MAP2C (GETPROPLIST un)
(CDR (GETPROPLIST un))
[FUNCTION (LAMBDA (pr val inv)
(AND (SETQ inv (CAR (Inverse pr)))
(MAPC val (FUNCTION (LAMBDA (e)
(DwimUnionProp e inv un]
(QUOTE CDDR])
(AddPropL
[LAMBDA (L P V)
(* edited: "24-Feb-81 22:10")
(* Like ADDPROP, but works for LISTS)
(COND
((ASSOC P L)
(NCONC1 (ASSOC P L)
V)
L)
(L (NCONC1 L (LIST P V)))
(T (LIST (LIST P V])
(Alg
[LAMBDA (u) (* edited: " 2-MAR-81 19:07")
(OR (GETPROP u (QUOTE Alg))
(SOME1 (SubSlots (QUOTE Alg))
(FUNCTION (LAMBDA (s)
(APPLY* s u])
(ApplicArgs
[LAMBDA (X) (* edited: " 4-MAR-81 13:26")
(CAR X])
(ApplicGenArgs
[LAMBDA (X) (* edited: " 4-MAR-81 13:44")
(CADDR X])
(ApplicGenBuild
[LAMBDA (X) (* edited: " 4-MAR-81 13:43")
(CADR X])
(ApplicGenInit
[LAMBDA (X) (* edited: " 4-MAR-81 13:43")
(CAR X])
(Apply-to-u
[LAMBDA (s) (* edited: "11-MAR-81 11:58")
(APPLY* s u])
(ApplyRule
[LAMBDA (r u msg tau)
(* edited: "20-Mar-81 00:46")
(* Unfortuantely, this doesn't check the value of AbortTask...)
(SETQ tau ArgU)
(SETQ ArgU u)
(PROG1 (AND (CPRIN1 75 CRLF " Rule " r (Abbrev r)
" is being applied to " C (OR msg " ")
CRLF)
(EVERY (SubSlots (QUOTE ThenParts))
(QUOTE XeqIfItExists))
(CPRIN1 75 " The Then Parts of the rule have been executed.
" CRLF))
(SETQ ArgU tau])
(Average
[LAMBDA (N M)
(* edited: "23-FEB-81 14:07")
(QUOTIENT (PLUS N M 1)
2])
(AverageWorths
[LAMBDA (u v)
(* edited: " 2-MAR-81 11:13")
(QUOTIENT (PLUS (Worth u)
(Worth v))
2])
(BestChoose
[LAMBDA (L) (* edited: "10-MAR-81 17:01")
(MAXIMUM (SUBSET L (QUOTE Unitp))
(QUOTE Worth])
(BestSubset
[LAMBDA (L) (* edited: "10-MAR-81 16:59")
(DREVERSE (NTH (SortByWorths (APPEND L))
(RAND 0 (LENGTH L])
(CPRIN1
[LAMBDA CprinX
(* edited: "28-FEB-81 18:57")
[COND
((IGREATERP Verbosity (ARG CprinX 1))
(SETQ cprintmp 1)
(RPTQ (SUB1 CprinX)
(PRIN1 (ARG CprinX (SETQ cprintmp (ADD1 cprintmp)))
TTY]
T])
(Certainty
[LAMBDA (N)
(* edited: "15-FEB-81 17:23")
(COND
((ILESSP N 100)
(QUOTE Inconceivable))
((ILESSP N 400)
(QUOTE Unlikely))
((ILESSP N 600)
(QUOTE Possible))
((ILESSP N 800)
(QUOTE Probable))
(T (QUOTE AlmostCertain])
(Check2AfterEditp
[LAMBDA (oldprop oldval invprop) (* edited: "23-FEB-81 18:55")
(AND (Inverse oldprop)
(NULL (APPLY* oldprop (CAR EDITPX)))
(SETQ invprop (CAR (Inverse oldprop)))
(MAPC oldval (FUNCTION (LAMBDA (e)
(REM1PROP e invprop (CAR EDITPX])
(CheckAfterEditp
[LAMBDA (prop val old invprop)
(* edited: "27-Feb-81 19:43")
(AND (SETQ invprop (CAR (Inverse prop)))
(PROGN [MAPC (SetDiff val (SETQ old (LISTGET EditpTemp prop)))
(FUNCTION (LAMBDA (e)
(DwimUnionProp e invprop (CAR EDITPX]
(MAPC (SetDiff old val)
(FUNCTION (LAMBDA (e)
(REM1PROP e invprop (CAR EDITPX])
(CheckElim
[LAMBDA NIL (* edited: "18-MAR-81 11:50")
(AND (YesNo NIL "Should I eliminate recently-computed values? ")
(MAPC Units (QUOTE InitialElimSlots])
(CheckTheValues
[LAMBDA (u s v) (* edited: " 2-MAR-81 18:40")
(* doublecheck that all the values on v
are legitimate entries for the s slot of
u)
T])
(Comp
[LAMBDA (F D SaveExpr?) (* edited: "19-MAR-81 13:22")
(RESETVARS (LAPFLG STRF SVFLG LCFIL LSTFIL)
(SETQ STRF T)
(SETQ SVFLG SaveExpr?)
(COMPILE1 F D))
(COND
(SaveExpr? F)
(T (REMPROP F (QUOTE EXPR])
(CreateUnit
[LAMBDA (N NOLD) (* edited: "18-MAR-81 15:42")
(COND
((NOT (ATOM N))
(WARNING (CONS "Must be atomic unit name! You typed: " N)))
((MEMB N Units)
(CreateUnit (NewNam N)
NOLD))
((MEMB NOLD Units)
(SETQ Units (CONS N Units))
(SETQ NewU (CONS N NewU))
[SETPROPLIST N (MergeProps (APPEND (GETPROPLIST N))
(SlotSubst N NOLD (GETPROPLIST NOLD]
[MAPC (PROPNAMES N)
(FUNCTION (LAMBDA (P)
(COND
((DontCopy P)
(REMPROP N P))
((DoubleCheck P)
(CheckTheValues N P (APPLY* P N]
(AddInv N)
N)
(T (SETQ Units (CONS N Units))
(PUT N (QUOTE Worth)
500)
N])
(CurSup
[LAMBDA (ESA)
(* edited: "23-FEB-81 13:36")
(CAR (CDDDDR ESA])
(CycleThruAgenda
[LAMBDA NIL
(* edited: "15-FEB-81 16:25")
(PROG (task)
TLOOP
(COND
(Agenda (SETQ task (CAR Agenda))
(SETQ Agenda (CDR Agenda))
(WorkOnTask task)
(* Note that this might add/change the Agenda)
T)
(T (RETURN NIL)))
(GO TLOOP])
(Date2
[LAMBDA (day mon temp dat) (* edited: "18-MAR-81 10:55")
(SETQ dat (UNPACK (DATE)))
(SETQ temp (MEMB (QUOTE -)
dat))
(SETQ day (PACK (LDIFF dat temp)))
[SETQ mon (PACK (LDIFF (CDR temp)
(MEMB (QUOTE -)
(CDR temp]
(PACK* mon day])
(DecrementCreditAssignment
[LAMBDA NIL
(* edited: "23-FEB-81 16:49")
(SETQ GCredit (ADD1 GCredit])
(DefineSlot
[LAMBDA (s) (* edited: " 2-MAR-81 14:17")
(* Really this should doublecheck that s
isa slot)
(COND
((CCODEP s) (* s already has a definition)
s)
((EXPRP s)
(Comp s (GETD s)
T))
(T [PUTD s (LIST (QUOTE LAMBDA)
(LIST (QUOTE u))
(LIST (QUOTE GETPROP)
(QUOTE u)
(KWOTE s]
(Comp s (GETD s])
(Defn
[LAMBDA (u) (* edited: " 2-MAR-81 19:08")
(OR (GETPROP u (QUOTE Defn))
(SOME1 (SubSlots (QUOTE Defn))
(FUNCTION (LAMBDA (s)
(APPLY* s u])
(DirectApplics
[LAMBDA (u)
(* edited: " 7-Mar-81 14:55")
(SUBSET (Applics u)
(FUNCTION (LAMBDA (A)
(MEMB (CADDR A)
(QUOTE (NIL 1])
(Divides
[LAMBDA (A B) (* edited: " 2-MAR-81 15:58")
(ZEROP (REMAINDER B A])
(DreplaceGet
[LAMBDA (L)
(* edited: " 2-MAR-81 11:37")
(COND
((Quoted (CADDR L))
(RPLACA L (CADR (CADDR L)))
(RPLACD (CDR L)
NIL)
L)
(T (RPLACA L (CADDR L))
(RPLACD (CDR L)
NIL)
(ATTACH (QUOTE APPLY*)
L])
(DwimUnionProp
[LAMBDA (A P V flag tmp8) (* edited: " 2-MAR-81 13:16")
(COND
((Unitp A)
(UnionProp A P V flag))
[(LITATOM A)
(PRIN1 (CONS A (QUOTE (is not yet a unit; make it one?)))
TTY)
(AND (YesNo)
(UnionProp A P V flag)
(PUTPROP A (QUOTE IsA)
(LIST (QUOTE Slot)))
(UnionProp (QUOTE Slot)
(QUOTE Examples)
A)
(NU A (AND (Inverse P)
(Unitp V)
[SETQ tmp8 (CAR (SOME (APPLY* (CAR (Inverse P))
V)
(QUOTE Unitp]
(PRIN1 " ... Copying from " TTY)
(PRIN1 tmp8 TTY)
(PRIN1 CRLF TTY)
tmp8]
(T NIL])
(EU
[NLAMBDA EDITPX (* edited: " 2-MAR-81 16:38")
(COND
((COND
((Unitp (CAR EDITPX))
(SETQ LastEdited EDITPX))
(EDITPX (PRIN1 "EU complaining: not an existing unit name! ")
(TERPRI)
(PRIN1 "What did you really mean to type? ")
(APPLY* (QUOTE EU)
(RATOM TTY))
NIL)
((SETQ EDITPX LastEdited)
(PRIN1 "=" TTY)
(PRIN1 (CAR EDITPX)
TTY)
(TERPRI)
T)
(T NIL))
[SETQ EditpTemp (COPY (GETPROPLIST (CAR EDITPX]
(EVAL (CONS (QUOTE EDITP)
EDITPX))
(MAP2C (GETPROPLIST (CAR EDITPX))
(CDR (GETPROPLIST (CAR EDITPX)))
(FUNCTION CheckAfterEditp)
(QUOTE CDDR))
(MAP2C EditpTemp (CDR EditpTemp)
(FUNCTION Check2AfterEditp)
(QUOTE CDDR))
(CONS (QUOTE FinishedEditing)
EDITPX))
(T NIL])
(Eurisko
[LAMBDA (Verbo EternalFlg) (* edited: " 4-MAR-81 12:06")
(COND
((FIXP Verbo)
(SETQ Verbosity Verbo))
(T NIL))
(PRIN1 "
Starting EURISKO
Douglas B. Lenat
February, 1981
")
(InitializeEurisko)
(SETQ TaskNum 0)
(CPRIN1 -1 CRLF "Ready to start? ")
(COND
((YesNo)
(START EternalFlg))
(T "Type (START) when you are ready."])
(ExtractInput
[LAMBDA (X) (* edited: " 5-MAR-81 17:04")
(CAR X])
(ExtractOutput
[LAMBDA (X) (* edited: " 5-MAR-81 17:05")
(CADR X])
(ExtractPriority
[LAMBDA (ESA)
(* edited: "23-FEB-81 14:01")
(CAR ESA])
(ExtractReasons
[LAMBDA (ESA)
(* edited: "23-FEB-81 13:35")
(CADDDR ESA])
(ExtractSlotName
[LAMBDA (ESA)
(* edited: "23-FEB-81 13:35")
(CADDR ESA])
(ExtractUnitName
[LAMBDA (task)
(* edited: "15-FEB-81 16:39")
(CADR task])
(Flatten
[LAMBDA (L)
(* edited: "23-FEB-81 17:25")
(COND
((NULL L)
NIL)
((ATOM L)
(LIST L))
(T (MAPCONC L (QUOTE Flatten])
(FractionOf
[LAMBDA (L P)
(* edited: "24-FEB-81 18:39")
(* compute the fraction of entries on L which satisfy predicate P)
(COND
((ATOM L)
0)
(T (QUOTIENT (FLOAT (LENGTH (SUBSET L P)))
(FLOAT (LENGTH L])
(GenArgs
[LAMBDA (X) (* edited: " 4-MAR-81 12:15")
(CADDR X])
(GenBuild
[LAMBDA (X) (* edited: " 4-MAR-81 12:15")
(CADR X])
(GenInit
[LAMBDA (X) (* edited: " 4-MAR-81 12:15")
(CAR X])
(Generalizations
[LAMBDA (u)
(* edited: "19-FEB-81 16:36")
(SelfIntersect (NCONC [MAPCONC (GETPROP (QUOTE Generalizations)
(QUOTE SubSlots))
(FUNCTION (LAMBDA (ss)
(APPEND (GETPROP u ss]
(GETPROP u (QUOTE Generalizations])
(Generalize1LispFn
[LAMBDA (bod tmp)
(* edited: "23-FEB-81 17:34")
(RandomSubst [RandomChoose (Generalizations (SETQ tmp (RandomChoose (SUBSET (SUBSET (SelfIntersect (Flatten bod))
(QUOTE Unitp))
(QUOTE Generalizations]
tmp bod])
(Generalize1LispPred
[LAMBDA (bod tmp)
(* edited: "23-FEB-81 17:34")
(RandomSubst [RandomChoose (Generalizations (SETQ tmp (RandomChoose (SUBSET (SUBSET (SelfIntersect (Flatten bod))
(QUOTE Unitp))
(QUOTE Generalizations]
tmp bod])
(GeneralizeIOPair
[LAMBDA (x) (* edited: " 2-MAR-81 18:08")
(SpecializeList x])
(GeneralizeLispFn
[LAMBDA (x)
(* edited: "23-FEB-81 17:32")
(* presumed to be given either the name of a predicate, or a list of the form (LAMBDA --))
(COND
((ATOM x)
(OR (RandomChoose (Generalizations x))
x))
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(GeneralizeLispFn Z))
(T Z]
[(EQ (CAR x)
(QUOTE LAMBDA))
(CONS (QUOTE LAMBDA)
(CONS (CADR x)
(MAPCAR (CDDR x)
(QUOTE Generalize1LispFn]
(T x])
(GeneralizeLispPred
[LAMBDA (x)
(* edited: "23-FEB-81 17:32")
(* presumed to be given either the name of a predicate, or a list of the form (LAMBDA --))
(COND
((ATOM x)
(OR (RandomChoose (Generalizations x))
x))
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(GeneralizeLispPred Z))
(T Z]
[(EQ (CAR x)
(QUOTE LAMBDA))
(CONS (QUOTE LAMBDA)
(CONS (CADR x)
(MAPCAR (CDDR x)
(QUOTE Generalize1LispPred]
(T x])
(GoodChoose
[LAMBDA (L) (* edited: "10-MAR-81 17:04")
(CAR (SOME (SortByWorths (APPEND L))
(QUOTE RandomP])
(GoodSubset
[LAMBDA (L) (* edited: "11-MAR-81 11:38")
(RandomSubset (BestSubset L])
(Half
[LAMBDA (n) (* edited: "18-MAR-81 13:38")
(IQUOTIENT n 2])
(HasHighWorth
[LAMBDA (u) (* edited: "15-FEB-81 13:48")
(AND (Unitp u)
(GREATERP (Worth u)
800])
(ISQRT
[LAMBDA (N) (* edited: " 4-MAR-81 15:32")
(FIX (SQRT N])
(IndirectApplics
[LAMBDA (u)
(* edited: " 7-Mar-81 14:55")
(SUBSET (Applics u)
(FUNCTION (LAMBDA (A)
(NOT (MEMB (CADDR A)
(QUOTE (NIL 1])
(InitialElimSlots
[LAMBDA (u) (* edited: " 4-MAR-81 16:41")
[MAPC SlotsToElimInitially (FUNCTION (LAMBDA (s)
(REMPROP u s]
(MAPC (ElimSlots u)
(FUNCTION (LAMBDA (s)
(REMPROP u s])
(InitializeCreditAssignment
[LAMBDA NIL
(* edited: "23-FEB-81 16:49")
(SETQ GCredit 1])
(InitializeEurisko
[LAMBDA (doit) (* edited: "19-MAR-81 14:17")
(Interrupts)
[COND
[(OR doit (YesNo NIL "Fully Initialize? "))
(PRIN1 "OK, defining Slots, UsedSlots, UnusedSlots, NUnitSlots as I go along... " TTY)
(SETQ Agenda NIL)
(SETQ Conjectures NIL)
(SETQ UnusedSlots NIL)
(SETQ UsedSlots NIL)
[MAPC Units (FUNCTION (LAMBDA (U)
(MAPC (PROPNAMES U)
(FUNCTION (LAMBDA (SL)
(OR (MEMB SL UsedSlots)
(MEMB SL SYSPROPS)
(PROGN (SETQ UsedSlots (CONS SL UsedSlots))
(DefineSlot SL]
[MAPC Units (FUNCTION (LAMBDA (u)
(AND (MEMB (QUOTE Slot)
(IsA u))
(NOT (MEMB u UsedSlots))
(SETQ UnusedSlots (CONS u UnusedSlots))
(DefineSlot u]
(SETQ UsedSlots (SORT UsedSlots))
(SETQ UnusedSlots (SORT UnusedSlots))
(PRIN1 "Done! " TTY)
(PRIN1 (LIST [LENGTH (SETQ Slots (MERGE (APPEND UsedSlots)
(APPEND UnusedSlots]
(QUOTE Slots))
TTY)
[AND (SETQ NUnitSlots (SUBSET Slots (QUOTE NUnitp)))
(YesNo NIL (CONCAT (LENGTH NUnitSlots)
" slots aren't defined as units. Do that now? "))
(MAPC (APPEND NUnitSlots)
(FUNCTION (LAMBDA (Z)
(TERPRI TTY)
(PRINT Z TTY)
(NU Z (QUOTE Abbrev))
(SETQ NUnitSlots (DREMOVE Z NUnitSlots]
(AND NewU (CPRIN1 -1 CRLF "Eliminate the recently synthesized units? ")
(CPRIN1 20 NewU)
(YesNo)
(Map&Print (COPY NewU)
(QUOTE KillUnit)))
(AND (SomeUneliminated)
(CPRIN1 -1 CRLF
"Eliminate the individual values filled in during an earlier run, for slots of units still in existence? "
)
(YesNo)
(MAPC Units (QUOTE InitialElimSlots]
(T (PRIN1 " OK, just initializing the slot definitions. " TTY)
(TERPRI TTY)
[MAPC Units (FUNCTION (LAMBDA (U)
(MAPC (PROPNAMES U)
(FUNCTION (LAMBDA (SL)
(OR (MEMB SL SYSPROPS)
(DefineSlot SL]
(MAPC Units (FUNCTION (LAMBDA (u)
(AND (MEMB (QUOTE Slot)
(IsA u))
(DefineSlot u]
(QUOTE !])
(InsideOf
[LAMBDA (X L)
(* edited: " 2-MAR-81 11:19")
(COND
((NULL L)
NIL)
((EQ X L)
T)
[(LISTP L)
(OR (InsideOf X (CAR L))
(InsideOf X (CDR L]
(T NIL])
(Instances
[LAMBDA (u)
(* edited: " 7-Mar-81 15:42")
(COND
((MEMB (QUOTE Heuristic)
(IsA u))
(QUOTE Applics))
((MEMB (QUOTE Op)
(IsA u))
(QUOTE Applics))
(T (QUOTE Examples])
(Interp1
[LAMBDA (r ArgU) (* edited: "15-FEB-81 14:13")
(* assembles pieces of the heuristic rule
r, and runs them on argument ArgU)
(COND
((EVERY (SubSlots (QUOTE IfParts))
(QUOTE TrueIfItExists)))
(T NIL])
(Interp2
[LAMBDA (r ArgU) (* edited: "24-Feb-81 21:30")
(* assembles pieces of the heuristic rule
r, and runs them on argument ArgU)
(* This is a more "vocal" interpeter than
interp1)
(COND
((EVERY (SubSlots (QUOTE IfParts))
(QUOTE TrueIfItExists))
(COND
((IGREATERP Verbosity 66)
(PRIN1 " All the IfParts of ")
(PRIN1 r)
(PRIN1 (Abbrev r))
(PRIN1 " are satisfied, so we are applying the ThenParts. ")
(TERPRI))
((IGREATERP Verbosity 50)
(PRIN1 r)
(PRIN1 " applies. ")
(TERPRI)))
(AND (EVERY (SubSlots (QUOTE ThenParts))
(QUOTE XeqIfItExists))
(CPRIN1 68 CRLF " All the ThenParts of " r (Abbrev r)
" have been successfully executed. " CRLF)))
(T NIL])
(Interrupts
[LAMBDA NIL (* edited: "19-MAR-81 14:14")
(* Control L for agenda length ;
Control N for numbe rof newly synthesized
units)
(INTERRUPTCHAR 12 (QUOTE (CPRIN1 -2 CRLF TAB TAB TAB TAB "Agenda length = " (LENGTH Agenda)
CRLF CRLF))
NIL)
(INTERRUPTCHAR 14 (QUOTE (CPRIN1 -2 CRLF TAB TAB TAB TAB (LENGTH NewU)
" newly synthesized units" CRLF CRLF))
NIL])
(IsAKindOf
[LAMBDA (s S)
(* edited: "23-FEB-81 13:45")
(OR (EQ s S)
(MEMB S (Generalizations s])
(KillSlot
[LAMBDA (s U1 V1 temp) (* edited: "11-MAR-81 15:17")
(AND (Slotp s)
(OR U1 (AND (BOUNDP (QUOTE u))
(SETQ U1 u)))
(PROG1 (COND
([NULL (OR V1 (SETQ V1 (APPLY* s U1]
(LIST U1 (QUOTE had)
(QUOTE no)
s
(QUOTE slot)))
((SETQ temp (CAR (Inverse s)))
[MAPC V1 (FUNCTION (LAMBDA (e)
(REM1PROP e temp U1]
(QUOTE (via Inverse)))
((SETQ temp (ToDelete s))
(APPLY* temp V1 s U1)
(QUOTE (via ToDelete)))
((SETQ temp (ToDelete1 s))
[MAPC V1 (FUNCTION (LAMBDA (e)
(APPLY* temp e s U1]
(QUOTE (via ToDelete1)))
(T NIL))
(REMPROP U1 s])
(KillUnit
[LAMBDA (u) (* edited: "11-MAR-81 15:14")
(SETQ Units (DREMOVE u Units))
(SETQ NewU (DREMOVE u NewU))
(MAPC (APPEND (GETPROPLIST u))
(FUNCTION KillSlot)
(QUOTE CDDR))
(QUOTE %.])
(KnownApplic
[LAMBDA (u a)
(* edited: " 7-Mar-81 15:09")
(CAR (SOME (Applics u)
(FUNCTION (LAMBDA (AP)
(EQUAL a (CAR AP])
(LessWorth
[LAMBDA (U1 U2) (* edited: "10-MAR-81 16:57")
(COND
((NOT (Unitp U2))
NIL)
((NOT (Unitp U1))
T)
(T (ILESSP (Worth U1)
(Worth U2])
(ListifyIfNec
[LAMBDA (X)
(* edited: "28-Feb-81 11:35")
(OR (LISTP X)
(CONS X NIL])
(ListsStarting
[LAMBDA (X L) (* edited: " 2-MAR-81 14:29")
(COND
((NLISTP L)
NIL)
[(EQ X (CAR L))
(CONS L (MAPCONC (CDR L)
(QUOTE ListsStartingAux]
(T (MAPCONC L (QUOTE ListsStartingAux])
(ListsStartingAux
[LAMBDA (L) (* edited: " 2-MAR-81 14:29")
(COND
((NLISTP L)
NIL)
[(EQ X (CAR L))
(CONS L (MAPCONC (CDR L)
(QUOTE ListsStartingAux]
(T (MAPCONC L (QUOTE ListsStartingAux])
(MAPAPPEND
[LAMBDA (L F)
(* edited: " 3-MAR-81 17:11")
(COND
((NULL L)
NIL)
(T (NCONC (APPEND (APPLY* F (CAR L)))
(MAPAPPEND (CDR L)
F])
(MAXIMUM
[LAMBDA (L2 F2) (* edited: " 4-MAR-81 11:49")
(* The element of L2 having the highest
F-value)
(* Currently, this presumes that L2 is a
lis tof integers)
(COND
((NLISTP L2)
L2)
((NLISTP (CDR L2))
(CAR L2))
(T (PROG (M MV)
(SETQ M (CAR L2))
(SETQ MV (APPLY* F2 (CAR L2)))
LOOP(SETQ L2 (CDR L2))
(COND
((NULL L2)
(RETURN M)))
[COND
((IGREATERP (APPLY* F2 (CAR L2))
MV)
(SETQ M (CAR L2))
(SETQ MV (APPLY* F2 (CAR L2]
(GO LOOP])
(Map&Print
[LAMBDA (L F) (* edited: "11-MAR-81 12:02")
(MAPC L (FUNCTION (LAMBDA (Z)
(PRIN1 (APPLY* F Z])
(MapApplics
[LAMBDA (u F NIt WhenToCheck WhenToQuit gen genf gena) (* edited: "19-MAR-81 16:12")
(* This may have to generate examples,
rather than merely calling Applics)
(MAPC (Applics u)
F)
(AND (SETQ gen (ApplicGenerator u))
(SETQ genf (ApplicGenBuild gen))
(SETQ gena (ApplicGenArgs gen))
(OR (FIXP NIt)
(SETQ NIt 300))
[OR (FIXP WhenToCheck)
(SETQ WhenToCheck (ADD1 (IQUOTIENT NIt 10]
[OR (FIXP WhenToQuit)
(SETQ WhenToQuit (TIMES CurPri UserImpatience
(ADD1 (FIX (PLUS .5 (LOG (MAX 2 (ADD1 Verbosity]
(SELECTQ (LENGTH gena)
[1 (for j from 1 to NIt until (TakingTooLong j WhenToCheck WhenToQuit)
do [PROGN (APPLY* F (EVAL (CAR gena)))
(SET (CAR gena)
(APPLY* (CAR genf)
(EVAL (CAR gena]
first (SET (CAR gena)
(CAR (ApplicGenInit gen]
(for j from 1 to NIt until (TakingTooLong j WhenToCheck WhenToQuit)
do [PROGN (APPLYEVAL F gena)
(MAP2C gena genf (FUNCTION (LAMBDA (Var Fn)
(SET Var (APPLYEVAL Fn gena]
first (MAP2C gena (ApplicGenInit gen)
(QUOTE SET])
(MapExamples
[LAMBDA (u F NIt WhenToCheck WhenToQuit gen genf gena) (* edited: "19-MAR-81 16:11")
(* This may have to generate examples,
rather than merely calling Applics)
(MAPC (Examples u)
F)
(AND (SETQ gen (Generator u))
(SETQ genf (GenBuild gen))
(SETQ gena (GenArgs gen))
(OR (FIXP NIt)
(SETQ NIt 1000))
[OR (FIXP WhenToCheck)
(SETQ WhenToCheck (ADD1 (IQUOTIENT NIt 10]
[OR (FIXP WhenToQuit)
(SETQ WhenToQuit (TIMES CurPri UserImpatience
(ADD1 (FIX (PLUS .5 (LOG (MAX 2 (ADD1 Verbosity]
(SELECTQ (LENGTH gena)
[1 (for j from 1 to NIt until (TakingTooLong j WhenToCheck WhenToQuit)
do [PROGN (APPLY* F (EVAL (CAR gena)))
(SET (CAR gena)
(APPLY* (CAR genf)
(EVAL (CAR gena]
first (SET (CAR gena)
(CAR (GenInit gen]
(for j from 1 to NIt until (TakingTooLong j WhenToCheck WhenToQuit)
do [PROGN (APPLYEVAL F gena)
(MAP2C gena genf (FUNCTION (LAMBDA (Var Fn)
(SET Var (APPLYEVAL Fn gena]
first (MAP2C gena (GenInit gen)
(QUOTE SET])
(MapUnion
[LAMBDA (L F)
(* edited: "15-FEB-81 13:42")
(* like MAPCONC, but instead of NCONCing the results we simply, nondestructive, union them)
(COND
((ATOM L)
NIL)
(T (UNION (APPLY* F (CAR L))
(MapUnion (CDR L)
F])
(MergeProps
[LAMBDA (L M) (* edited: "11-MAR-81 15:12")
(* L and M are each property lists)
(MAP2C M (CDR M)
[FUNCTION (LAMBDA (P V)
(COND
((NOT (Slotp P))
NIL)
[(LISTGET L P)
(LISTPUT L (UNION (ListifyIfNec (LISTGET L P))
(ListifyIfNec V]
(T (SETQ L (NCONC L (LIST P V]
(QUOTE CDDR))
(* (NCONC (MAPCON L (FUNCTION (LAMBDA (LT) ((LAMBDA (GL) (COND
(GL (RPLACA GL (UNION (ListifyIfNec (CAR GL)) (ListifyIfNec
(CADR LT)))) NIL) (T (LIST (CAR LT) (CADR LT))))) (CDR (MEMB
(CAR LT) M))))) (QUOTE CDDR)) M))
L])
(MergeTasks
[LAMBDA (L M) (* edited: "18-MAR-81 15:34")
(MERGE [SUBSET L (FUNCTION (LAMBDA (TaskToBeAdded TaskAlreadyThere NewReas)
(COND
((NOT (WorthWorkingOn TaskToBeAdded))
NIL)
((SETQ TaskAlreadyThere (WholeTask (ExtractUnitName TaskToBeAdded)
(ExtractSlotName TaskToBeAdded)
(CurSup TaskToBeAdded)
Agenda))
(* Then it is already on the agenda!)
[NCONC (ExtractReasons TaskAlreadyThere)
(SETQ NewReas (SetDiff (ExtractReasons TaskAlreadyThere)
(ExtractReasons TaskToBeAdded]
(CPRIN1 87 CRLF "Ha! this task was ALREADY on the agenda: " (WaxOn
TaskToBeAdded)
CRLF
"So instead of adding this as a NEW task, we just stick on the reasons "
NewReas ", and boost the priority to ")
(ResetPri TaskAlreadyThere (ExtractPriority TaskToBeAdded)
(ExtractPriority TaskAlreadyThere)
NewReas)
(CPRIN1 87 (ExtractPriority TaskAlreadyThere)
"." CRLF)
NIL)
(T T]
M
(QUOTE OrderTasks])
(NU
[LAMBDA (N NOLD) (* edited: "11-MAR-81 15:18")
(COND
((NOT (LITATOM N))
(PRIN1 "Must be atomic unit name! You typed: " TTY)
N)
((MEMB N Units)
(PRIN1 "Sorry, it is already a unit! " TTY)
N)
((MEMB NOLD Units)
(SETQ Units (CONS N Units))
[SETPROPLIST N (MergeProps (GETPROPLIST N)
(SUBST N NOLD (GETPROPLIST NOLD]
(SETQ WarnSlots NIL)
[MAPC (PROPNAMES N)
(FUNCTION (LAMBDA (P)
(COND
((DontCopy P)
(REMPROP N P))
((DoubleCheck P)
(SETQ WarnSlots (CONS P WarnSlots]
(COND
(WarnSlots (CPRIN1 0 CRLF "Warning: doublecheck the values stored in: " WarnSlots CRLF CRLF)
))
(EVAL (LIST (QUOTE EU)
N))
(AddInv N)
(LIST N (QUOTE HasBeenInitialized)))
(T (SETQ Units (CONS N Units))
(PUT N (QUOTE Worth)
500)
(EVAL (LIST (QUOTE EU)
N))
(AddInv N)
(LIST N (QUOTE HasBeenInitialized])
(NUnitp
[LAMBDA (u)
(* edited: "28-FEB-81 18:36")
(NOT (Unitp u])
(NearnessTo
[LAMBDA (N X)
(* edited: "24-Feb-81 22:21")
(* This certainly works for nearness of N to .1)
(DIFFERENCE 1000 (TIMES 100000 (SQUARE (DIFFERENCE N X])
(NewNam
[LAMBDA (A)
(* edited: "25-FEB-81 18:52")
(PROG (N M)
(SETQ N 1)
NLOOP
(SETQ M (PACK* A (QUOTE -)
N))
(COND
((Unitp M)
(SETQ N (ADD1 N))
(GO NLOOP))
(T (RETURN M])
(NoRepeatsIn
[LAMBDA (L)
(* edited: " 7-Mar-81 14:22")
(COND
((MEMBER (CAR L)
(CDR L))
NIL)
(T (NoRepeatsIn (CDR L])
(OrderTasks
[LAMBDA (T1 T2) (* edited: " 2-MAR-81 18:16")
(IGREATERP (CAR T1)
(CAR T2])
(Percentify
[LAMBDA (N) (* edited: " 2-MAR-81 17:59")
(CONCAT (FIX (TIMES 100 (PLUS N .005)))
(QUOTE "%%"])
(PunishSeverely
[LAMBDA (u) (* edited: "18-MAR-81 16:32")
(AND (Unitp u)
(PUT u (QUOTE Worth)
(Half (Worth u])
(Quoted
[LAMBDA (X)
(* edited: " 2-MAR-81 11:34")
(AND (LISTP X)
(EQ (CAR X)
(QUOTE QUOTE])
(REM1PROP
[LAMBDA (a p v) (* edited: "18-MAR-81 11:13")
(OR (NOT (LITATOM a))
(NOT (LITATOM p))
(AND (MEMB v (GETPROP a p))
(DREMOVE v (GETPROP a p)))
(DREMOVE v (APPLY* p a))
(REMPROP a p])
(RandomChoose
[LAMBDA (L)
(* edited: "23-FEB-81 14:14")
(CAR (NTH L (RAND 1 (LENGTH L])
(RandomP
[LAMBDA NIL
(* edited: "23-FEB-81 14:25")
(EQ 1 (RAND 0 1])
(RandomSubset
[LAMBDA (L) (* edited: "10-MAR-81 16:50")
(SUBSET L (QUOTE RandomP])
(RandomSubst
[LAMBDA (X Y Z NTries tes)
(* edited: "20-Mar-81 00:38")
(OR NTries (SETQ NTries 4))
(COND
((ZEROP NTries)
Z)
((EQUAL (SETQ tes (RandomSubst* X Y Z))
Z)
(RandomSubst X Y Z (SUB1 NTries)))
(T tes])
(RandomSubst*
[LAMBDA (X Y Z)
(* edited: "20-Mar-81 00:26")
(COND
((EQUAL X Y)
Z)
((EQUAL Y Z)
(COND
((RandomP)
Y)
(T X)))
((NLISTP Z)
Z)
(T (CONS (RandomSubst* X Y (CAR Z))
(RandomSubst* X Y (CDR Z])
(ResetPri
[LAMBDA (OldT NewP OldP NewR) (* edited: "18-MAR-81 15:22")
(* Given an old task OldT with priority OldP we have added it anew to the agenda
with priority NewP and brand new reasons NewR)
(RPLACA OldT (MAX 1000 (IPLUS (MAX OldP NewP)
(MAX 10 (ITIMES 100 (LENGTH NewR])
(RunAlg
[LAMBDA (f a b c d e)
(* edited: " 2-MAR-81 10:54")
(COND
((Alg f)
(APPLY* (Alg f)
a b c d e))
((GETD f)
(EVAL (LIST f a b c d e)))
(T NIL])
(RunDefn
[LAMBDA (f a b c d e)
(* edited: " 2-MAR-81 10:54")
(COND
((GETPROP f (QUOTE Defn))
(APPLY* (Defn f)
a b c d e))
((GETD f)
(EVAL (LIST f a b c d e)))
(T NIL])
(SOME1
[LAMBDA (L F) (* edited: " 2-MAR-81 19:07")
(COND
((NULL L)
NIL)
((APPLY* F (CAR L)))
(T (SOME1 (CDR L)
F])
(SOS
[LAMBDA NIL (* edited: "18-MAR-81 11:46")
(COND
((DRIBBLEFILE)
(CPRIN1 -1 "Closing " (DRIBBLEFILE)
CRLF))
(T (PRIN1 "Note: no dribble file was previously open.")
(TERPRI)))
(DRIBBLE (PACK* (QUOTE TRACE.)
(Date2)))
(CPRIN1 -1 (DRIBBLEFILE)
" is now open." CRLF)
(DATE])
(SQUARE
[LAMBDA (X)
(* edited: "24-Feb-81 22:19")
(TIMES X X])
(START
[LAMBDA (EternalFlg) (* edited: " 4-MAR-81 12:13")
(CycleThruAgenda)
(PROG (UnitsFocusedOn UU)
LOOP(COND
((SETQ UU (SetDiff Units UnitsFocusedOn)))
(EternalFlg (CPRIN1 3 CRLF CRLF CRLF
"Have focused on all the units at least once. Starting another pass through them."
CRLF CRLF CRLF)
(SETQ UnitsFocusedOn NIL))
(T (PRIN1 "
Should I continue with another pass? ")
(OR (YesNo)
(RETURN (QUOTE EuriskoHalting)))
(SETQ UnitsFocusedOn NIL)))
(SETQ UnitsFocusedOn (CONS (WorkOnUnit (MAXIMUM UU (QUOTE Worth)))
UnitsFocusedOn))
(GO LOOP])
(SelfIntersect
[LAMBDA (X)
(* edited: "19-FEB-81 16:36")
(INTERSECTION X X])
(SetDiff
[LAMBDA (L M)
(* edited: "23-FEB-81 19:03")
(* presumes that L and M are lists of atoms. Nondestructive)
(SUBSET L (FUNCTION (LAMBDA (v)
(NOT (MEMB v M])
(SetIntersect
[LAMBDA (L M) (* edited: "11-MAR-81 11:44")
(SUBSET L (FUNCTION (LAMBDA (Z)
(MEMB Z M])
(SibSlots
[LAMBDA (s) (* edited: "11-MAR-81 13:26")
(MapUnion (SuperSlots s)
(QUOTE SubSlots])
(SlotNames
[LAMBDA (u)
(* edited: "23-FEB-81 14:16")
(SUBSET (PROPNAMES u)
(FUNCTION (LAMBDA (S)
(NOT (MEMB S SYSPROPS])
(SlotSubst
[LAMBDA (N NOLD L) (* edited: "18-MAR-81 15:44")
(COND
((NULL L)
NIL)
(T (CONS (CAR L)
(CONS (SUBST N NOLD (CADR L))
(SlotSubst N NOLD (CDDR L])
(Slotp
[LAMBDA (s) (* edited: "11-MAR-81 14:59")
(MEMB (QUOTE Slot)
(GETPROP s (QUOTE IsA])
(SomeUneliminated
[LAMBDA NIL (* edited: "11-MAR-81 11:59")
(SOME Units (FUNCTION (LAMBDA (u)
(OR (SOME SlotsToElimInitially (FUNCTION Apply-to-u))
(SOME (ElimSlots u)
(FUNCTION Apply-to-u])
(SortByWorths
[LAMBDA (L) (* edited: "10-MAR-81 16:55")
(SORT L (QUOTE LessWorth])
(Specializations
[LAMBDA (u)
(* edited: "19-FEB-81 16:36")
(SelfIntersect (NCONC [MAPCONC (GETPROP (QUOTE Specializations)
(QUOTE SubSlots))
(FUNCTION (LAMBDA (ss)
(APPEND (GETPROP u ss]
(GETPROP u (QUOTE Specializations])
(Specialize1LispExpr
[LAMBDA (bod tmp tmp2 fbod)
(* edited: "20-Mar-81 00:15")
(* AreUnits is the list of units mentioned in bod ; HaveSpec are those which have specializations already)
(COND
([SETQ tmp2 (RandomChoose (Specializations (SETQ tmp (RandomChoose (SETQ HaveSpec
(UNION (SUBSET (SETQ AreUnits
(SUBSET (SETQ fbod
(SelfIntersect
(Flatten bod)))
(QUOTE Unitp)))
(QUOTE Specializations))
HaveSpec]
(SETQ UDiff (LIST tmp RArrow tmp2))
(RandomSubst tmp2 tmp bod))
([SETQ tmp2 (SpecializeNumber (SETQ tmp (RandomChoose (SUBSET (SelfIntersect fbod)
(QUOTE NUMBERP]
(SETQ UDiff (LIST tmp RArrow tmp2))
(RandomSubst tmp2 tmp bod))
(T bod])
(Specialize1LispFn
[LAMBDA (bod) (* edited: "18-MAR-81 12:01")
(Specialize1LispExpr bod])
(Specialize1LispPred
[LAMBDA (bod tmp tmp2) (* edited: "18-MAR-81 12:02")
(Specialize1LispExpr bod])
(SpecializeBit
[LAMBDA (b)
(* edited: "28-Feb-81 17:22")
(NOT b])
(SpecializeCompiledLispCode
[LAMBDA (X) (* edited: " 4-MAR-81 16:08")
X])
(SpecializeDataType
[LAMBDA (x tmp) (* edited: " 6-MAR-81 16:03")
(COND
[(LISTP x)
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeDataType Z))
(T Z]
((SETQ tmp (RandomChoose (Specializations x)))
(SETQ UDiff (LIST x RArrow tmp))
tmp)
(T x])
(SpecializeIOPair
[LAMBDA (x) (* edited: " 2-MAR-81 18:20")
(* eventually: look thru the (i o) pairs, and make a few new ones, with i's
selected from the set of i's, and o's similarly -- or select from examples of
things which i and o are examples of)
x])
(SpecializeLispFn
[LAMBDA (x) (* edited: " 2-MAR-81 17:50")
(* presumed to be given either the name of
a predicate, or a list of the form
(LAMBDA --))
(COND
((NUMBERP x)
(SpecializeNumber x))
((LITATOM x)
(COND
[(Specializations x)
(SETQ UDiff (LIST x RArrow (RandomChoose (Specializations x]
(T x)))
((NLISTP x)
x)
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeLispFn Z))
(T Z]
[(EQ (CAR x)
(QUOTE LAMBDA))
(CONS (QUOTE LAMBDA)
(CONS (CADR x)
(MAPCAR (CDDR x)
(QUOTE Specialize1LispFn]
(T x])
(SpecializeLispPred
[LAMBDA (x) (* edited: " 2-MAR-81 17:50")
(* presumed to be given either the name of
a predicate, or a list of the form
(LAMBDA --))
(COND
((NUMBERP x)
(SpecializeNumber x))
((LITATOM x)
(COND
[(Specializations x)
(SETQ UDiff (LIST x RArrow (RandomChoose (Specializations x]
(T x)))
((NLISTP x)
x)
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeLispPred Z))
(T Z]
[(EQ (CAR x)
(QUOTE LAMBDA))
(CONS (QUOTE LAMBDA)
(CONS (CADR x)
(MAPCAR (CDDR x)
(QUOTE Specialize1LispPred]
(T x])
(SpecializeList
[LAMBDA (x)
(* edited: "25-FEB-81 17:12")
(COND
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeList Z))
(T Z]
(T (SETQ UDiff (LIST (QUOTE Eliminated:)))
(SUBSET x (FUNCTION (LAMBDA (R)
(COND
((RandomP)
(NCONC1 UDiff R)
NIL)
(T T])
(SpecializeNIL
[LAMBDA (X)
(* edited: "23-FEB-81 14:51")
(WARNING (CONS X " can't be specialized if it doesn't have a known DataType! "])
(SpecializeNumber
[LAMBDA (x)
(* edited: "26-Feb-81 15:29")
(COND
[(LISTP x)
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeNumber Z))
(T Z]
[(FIXP x)
(CADDR (SETQ UDiff (LIST x RArrow (RAND 1 x]
[(NUMBERP x)
(CADDR (SETQ UDiff (LIST x RArrow (QUOTIENT (RAND 0 (FIX (TIMES x 200)))
200.0]
(T NIL])
(SpecializeSlot
[LAMBDA (x tmp)
(* edited: "25-FEB-81 17:27")
(COND
[(LISTP x)
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeSlot Z))
(T Z]
((SETQ tmp (RandomChoose (Specializations x)))
(SETQ UDiff (LIST x RArrow tmp))
tmp)
(T x])
(SpecializeText
[LAMBDA (x)
(* edited: "25-FEB-81 17:26")
(COND
[(LISTP (CAR x))
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeText Z))
(T Z]
(T (SETQ UDiff (LIST (QUOTE Eliminated:)))
(SUBSET x (FUNCTION (LAMBDA (R)
(COND
((RandomP)
(NCONC1 UDiff R)
NIL)
(T T])
(SpecializeUnit
[LAMBDA (x tmp)
(* edited: "25-FEB-81 17:27")
(COND
[(LISTP x)
(MAPCAR x (FUNCTION (LAMBDA (Z)
(COND
((RandomP)
(SpecializeUnit Z))
(T Z]
((SETQ tmp (RandomChoose (Specializations x)))
(SETQ UDiff (LIST x RArrow tmp))
tmp)
(T x])
(StrongUnsaveDef
[LAMBDA (F) (* edited: " 2-MAR-81 15:46")
(COND
((EQ (QUOTE nothing)
(CAR (UNSAVEDEF F)))
(CAR (LOADDEF F)))
(T F])
(TakingTooLong
[LAMBDA (j WhenToCheck WhenToQuit) (* edited: "18-MAR-81 14:39")
(COND
((LEQ j 1)
(SETQ MapCycleTime (CLOCK 0))
NIL)
((AND (EQ 0 (REMAINDER j WhenToCheck))
(IGEQ (DIFFERENCE (CLOCK 0)
MapCycleTime)
WhenToQuit))
(CPRIN1 56 " Hmmm... this is taking too long! On to better things!" CRLF)
T)
(T NIL])
(TheFirstOf
[LAMBDA (X Y) (* edited: "18-MAR-81 15:52")
X])
(TheSecondOf
[LAMBDA (X Y) (* edited: "18-MAR-81 16:58")
Y])
(TinyReward
[LAMBDA (u) (* edited: "18-MAR-81 12:07")
(PUT u (QUOTE Worth)
(ADD1 (Worth u])
(TrueIfItExists
[LAMBDA (s) (* edited: "15-FEB-81 15:40")
(* This is an aux fn of rule interpreters. We assume that the interpreter is being
run on a rule called r, which is to be applied to a unit ArgU)
([LAMBDA (z)
(COND
((NULL z))
((ILESSP Verbosity 80)
(APPLY* z ArgU))
((APPLY* z ArgU)
(PRIN1 " the ")
(PRIN1 s)
(PRIN1 " slot of ")
(PRIN1 r)
(PRIN1 " holds for ")
(PRIN1 ArgU)
(TERPRI)
T)
((IGREATERP Verbosity 95)
(PRIN1 " the ")
(PRIN1 s)
(PRIN1 " slot of ")
(PRIN1 r)
(PRIN1 " didn't hold for ")
(PRIN1 ArgU)
(TERPRI)
NIL]
(APPLY* s r])
(UnGet
[LAMBDA (flag)
(* edited: " 3-MAR-81 16:41")
(* One can call this on units by saying, say, (UnGet (MAPCAR Units (QUOTE GETPROPLIST))))
(MAPC (COND
((LISTP flag)
flag)
((NULL flag)
(OR GFNS EURFNS))
((LITATOM flag)
(LIST flag))
(T NIL))
(FUNCTION (LAMBDA (F)
(MAPC (PROG (tmp)
[SETQ tmp (ListsStarting (QUOTE GETPROP)
(COND
((CCODEP F)
(StrongUnsaveDef F)
(GETD F))
((GETD F))
((LISTP F)
F)
(T (WARNING
"In the process of UnGet-ting, found a function which was not an EXPR or SUBR!"]
[COND
(tmp ([LAMBDA (FF)
(AND (LITATOM F)
(MARKASCHANGED F))
(COND
(FF (CPRIN1 20 FF " ")
(CPRIN1 40 "(" (LENGTH tmp)
" changes.); "]
(COND
((LITATOM F)
F)
[(CAR (SOME Units (FUNCTION (LAMBDA (u)
(EQ F (GETPROPLIST u]
(T NIL]
(RETURN tmp))
(QUOTE DreplaceGet])
(UnionProp
[LAMBDA (A P V flag) (* edited: " 2-MAR-81 13:16")
(OR (MEMB V (APPLY* P A))
(ADDPROP A P V flag])
(Unitp
[LAMBDA (u) (* edited: "15-FEB-81 13:48")
(* u is a unit iff it has a Worth property
on its plist)
(Worth u])
(WaxOn
[LAMBDA (task)
(* edited: "15-FEB-81 17:25")
(LIST (QUOTE It)
(QUOTE is)
(Certainty (CAR task))
(LIST (CAR task))
(QUOTE that)
(QUOTE finding)
(CADDR task)
(QUOTE of)
(CADR task)
(QUOTE will)
(QUOTE be)
(QUOTE worthwhile,)
(QUOTE since:)
(CADDDR task])
(WholeTask
[LAMBDA (u s sup L) (* edited: "18-MAR-81 15:33")
(* Find a task on the agenda L which is to
work on slot s of unit u)
(CAR (SOME L (FUNCTION (LAMBDA (Z)
(AND (EQ u (ExtractUnitName Z))
(EQ s (ExtractSlotName Z))
(EQ sup (CurSup Z])
(WorkOnTask
[LAMBDA (task ArgU TaskResults)
(* edited: "19-Mar-81 23:47")
(SETQ AbortTask? NIL)
(SETQ TaskNum (ADD1 TaskNum))
(COND
((IGREATERP Verbosity 50)
(CPRIN1 1 CRLF "Task " TaskNum ": Working on a new promising task: " (WaxOn task)
CRLF))
((IGREATERP Verbosity 10)
(TERPRI)
(PRIN1 "Task ")
(PRIN1 TaskNum)
(PRIN1 ": ")
(PRIN1 "Working on the promising task ")
(PRIN1 task)
(TERPRI)))
(SETQ CurPri (ExtractPriority task))
(SETQ ArgU task)
(SETQ CurUnit (ExtractUnitName task))
(SETQ CurSlot (ExtractSlotName task))
(SETQ CurReasons (ExtractReasons task))
(SETQ CurSup (CurSup task))
[OR [EVERY (SubSlots (QUOTE IfTaskParts))
(FUNCTION (LAMBDA (p)
(SETQ HeuristicAgenda (Examples (QUOTE Heuristic)))
(PROG (r)
HLOOP
(COND
(AbortTask? (RETURN NIL))
((NULL HeuristicAgenda)
(RETURN T)))
(SETQ r (CAR HeuristicAgenda))
(SETQ HeuristicAgenda (CDR HeuristicAgenda))
(COND
((NULL (APPLY* p r))
(GO HLOOP))
((SELECTQ (APPLY* (APPLY* p r)
task)
(AbortTask (RETURN NIL))
(NIL NIL)
(AND (CPRIN1 71 " The " p " slot of heuristic " r (Abbrev r)
" applies to the current task. " CRLF)
(EVERY (SubSlots (QUOTE ThenParts))
(QUOTE XeqIfItExists))
(CPRIN1 75 " The Then Parts of the rule have been executed.
" CRLF)))
(GO HLOOP))
(T (GO HLOOP)))
(GO HLOOP]
(SETQ TaskResults (AddPropL TaskResults (QUOTE Termination)
(QUOTE Aborted]
(CPRIN1 64 " The results of this task were: " TaskResults CRLF)
(CPRIN1 65 CRLF)
TaskResults])
(WorkOnUnit
[LAMBDA (U TaskResults) (* edited: " 4-MAR-81 12:14")
(SETQ TaskNum (ADD1 TaskNum))
(COND
((IGREATERP Verbosity 10)
(TERPRI)
(PRIN1 "Task ")
(PRIN1 TaskNum)
(PRIN1 ": ")
(PRIN1 "Focusing on ")
(PRIN1 U)
(TERPRI)))
[MAPC (Examples (QUOTE Heuristic))
(FUNCTION (LAMBDA (H) (* try to apply H to unit U)
(APPLY* Interp H U]
(CPRIN1 65 CRLF)
(AND TaskResults (CPRIN1 64 " The results of this task so far are: " TaskResults CRLF))
(CPRIN1 65 CRLF)
(CycleThruAgenda)
U])
(WorthWorkingOn
[LAMBDA (task) (* edited: "18-MAR-81 12:21")
(IGEQ (ExtractPriority task)
MinPri])
(XeqIfItExists
[LAMBDA (s) (* edited: "15-FEB-81 15:40")
(* This is an aux fn of rule interpreters. We assume that the interpreter is being
run on a rule called r, which is to be applied to a unit ArgU)
(* This function evaluates the s part of
r, which is presumably a Then- part of
some sort)
([LAMBDA (z)
(COND
((NULL z)
T)
((APPLY* z ArgU)
(COND
((IGREATERP Verbosity 80)
(PRIN1 " the ")
(PRIN1 s)
(PRIN1 " slot of ")
(PRIN1 r)
(PRIN1 " has been applied to ")
(PRIN1 ArgU)
(TERPRI)
T))
T)
((IGREATERP Verbosity 75)
(PRIN1 " the ")
(PRIN1 s)
(PRIN1 " slot of ")
(PRIN1 r)
(PRIN1 " was applied to ")
(PRIN1 ArgU)
(PRIN1 " but for some reason it signalled a failure")
(COND
((IGREATERP Verbosity 90)
(PRIN1 ", so the remaining ThenParts of the rule weren't applied.")))
(TERPRI)
NIL]
(APPLY* s r])
(YesNo
[LAMBDA (i prompt)
(* edited: " 2-MAR-81 10:47")
(AND prompt (NULL i)
(PRIN1 CRLF TTY)
(PRIN1 prompt TTY)
(PRIN1 " (Y or N): " TTY))
(MEMB (OR i (RATOM TTY))
(QUOTE (Y Yes YES y yes])
)
(RPAQQ Units (H14 H13 HAvoid3 HAvoid2 HAvoid H12 HindSightRule NonCriterialSlot H2 ThenDeleteOldConcepts TheFirstOf TheSecondOf
OR AND Abbrev Add Alg Anything ApplicGenerator Applics Arity BestChoose BestSubset Bit CompiledDefn Conjecture
Creditors CriterialSlot DataType Defn DirectApplics DivisorsOf Domain DontCopy DoubleCheck EQ EQUAL ElimSlots
English EvenNum Examples FastAlg FastDefn Format Generalizations Generator GoodChoose GoodSubset H1 H10 H11 H3
H4 H5 H6 H7 H8 H9 Heuristic IEQP IGEQ IGREATERP ILEQ ILESSP IfAboutToWorkOnTask IfFinishedWorkingOnTask IfParts
IfPotentiallyRelevant IfTaskParts IfTrulyRelevant IfWorkingOnTask InDomainOf IndirectApplics Inverse IsA
IsRangeOf IterativeAlg IterativeDefn MathConcept MathObj MathOp MathPred Multiply NNumber NonExamples NumOp
OddNum Op PerfNum PerfSquare Pred PrimeNum ProtoConjec RandomChoose RandomSubset Range RecursiveAlg
RecursiveDefn ReprConcept Set SetOfNumbers SetOp SibSlots Slot Specializations Square SubSlots Successor
SuperSlots Task ThenAddToAgenda ThenCompute ThenConjecture ThenDefineNewConcepts ThenModifySlots ThenParts
ThenPrintToUser ToDelete ToDelete1 Transpose Unit UnitOp UnitizedAlg UnitizedDefn Worth los1 los2 los3 los4
los5 los6 los7 win1))
(PUTPROPS H14 IsA (HindSightRule Heuristic Op)
English (IF C is about to die, then try to form a new heuristic, one which -- had it existed earlier -- would
have prevented C from ever being defined in the first place , by preventing the same losing sort of
entity being the replacer)
IfPotentiallyRelevant [LAMBDA (f)
(MEMB f DeletedUnits]
Worth 700
Abbrev (Form a rule that would have prevented this mistake)
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF CRLF
"Just before destroying a losing concept, Eurisko generalized from that bad experience, in the following way: "
"Eurisko will no longer change something into " CTo " inside any of these "
CSlotSibs " slots of a unit " "when trying to find " GSlot
" of that unit. We learned our lesson from "
ArgU CRLF CRLF]
ThenCompute [LAMBDA (C)
(AND [SETQ CSlot
(CADR (ASSOC (QUOTE SlotToChange)
(CAR (CDDDDR (SETQ CTask
(CADDAR
(SETQ CTRes
(CAR (SOME (Applics (CAR (Creditors C)))
(FUNCTION
(LAMBDA (A)
(MEMB C (CADR A]
(SETQ GSlot (CADDR CTask))
(OR (ILEQ (LENGTH (SETQ CSlotSibs (SibSlots CSlot)))
50)
(SETQ CSlotSibs (LIST CSlot)))
(OR CSlotSibs (SETQ CSlotSibs (LIST CSlot)))
(SOME (CAR (LAST CTRes))
(FUNCTION (LAMBDA (Z)
(COND ((EQ (CADR Z)
RArrow)
(SETQ CFrom (CAR Z))
(SETQ CTo (CADDR Z))
T)
(T NIL]
ThenDefineNewConcepts [LAMBDA (task)
(SETQ NewUnit (CreateUnit (QUOTE HAvoid3)
(QUOTE HAvoid3)))
(SETPROPLIST NewUnit (SUBPAIR (QUOTE (GSlot CSlot CSlotSibs NotForReal CFrom CTo))
(LIST GSlot CSlot CSlotSibs T CFrom CTo)
(GETPROPLIST NewUnit)))
(SETQ NewUnits (CDR (ASSOC (QUOTE NewUnits)
TaskResults)))
[COND (NewUnits (NCONC1 NewUnits NewUnit))
(T (SETQ TaskResults (CONS (LIST (QUOTE NewUnits)
NewUnit)
TaskResults]
[ADDPROP (QUOTE H14)
(QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(InitializeCreditAssignment)
(LIST (QUOTE WillAvoid)
(QUOTE changing)
(QUOTE anything)
(QUOTE into)
(QUOTE a)
CTo
(QUOTE inside)
(QUOTE the)
CSlot
(QUOTE slot)
(COND ((CDR CSlotSibs)
(LIST (QUOTE ,)
(QUOTE actually)
(QUOTE all)
(QUOTE of)
(QUOTE these:)
CSlotSibs
(QUOTE ,)))
(T (QUOTE ,)))
(QUOTE of)
(QUOTE units)
(QUOTE whenever)
(QUOTE finding)
GSlot
(QUOTE of)
(QUOTE them]
[MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
(FUNCTION (LAMBDA (H)
(ADDPROP H (QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(DecrementCreditAssignment]
(PUT NewUnit (QUOTE Creditors)
(SETQ Creditors (CONS (QUOTE H14)
Creditors)))
T])
(PUTPROPS H13 IsA (HindSightRule Heuristic Op)
English (IF C is about to die, then try to form a new heuristic, one which -- had it existed earlier -- would
have prevented C from ever being defined in the first place , by preventing the kind of changed
object from being changed)
IfPotentiallyRelevant [LAMBDA (f)
(MEMB f DeletedUnits]
Worth 700
Abbrev (Form a rule that would have prevented this mistake)
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF CRLF
"Just before destroying a losing concept, Eurisko generalized from that bad experience, in the following way: "
"Eurisko will no longer alter the " CFrom " inside any of these " CSlotSibs
" slots of a unit "
"when trying to find " GSlot " of that unit. We learned our lesson from " ArgU
CRLF CRLF]
ThenCompute [LAMBDA (C)
(AND [SETQ CSlot
(CADR (ASSOC (QUOTE SlotToChange)
(CAR (CDDDDR (SETQ CTask
(CADDAR
(SETQ CTRes
(CAR (SOME (Applics (CAR (Creditors C)))
(FUNCTION
(LAMBDA (A)
(MEMB C (CADR A]
(SETQ GSlot (CADDR CTask))
(OR (ILEQ (LENGTH (SETQ CSlotSibs (SibSlots CSlot)))
50)
(SETQ CSlotSibs (LIST CSlot)))
(OR CSlotSibs (SETQ CSlotSibs (LIST CSlot)))
(SOME (CAR (LAST CTRes))
(FUNCTION (LAMBDA (Z)
(COND ((NLISTP Z)
NIL)
((EQ (CADR Z)
RArrow)
(SETQ CFrom (CAR Z))
(SETQ CTo (CADDR Z))
T)
(T NIL]
ThenDefineNewConcepts [LAMBDA (task)
(SETQ NewUnit (CreateUnit (QUOTE HAvoid2)
(QUOTE HAvoid2)))
(SETPROPLIST NewUnit (SUBPAIR (QUOTE (GSlot CSlot CSlotSibs NotForReal CFrom CTo))
(LIST GSlot CSlot CSlotSibs T CFrom CTo)
(GETPROPLIST NewUnit)))
(SETQ NewUnits (CDR (ASSOC (QUOTE NewUnits)
TaskResults)))
[COND (NewUnits (NCONC1 NewUnits NewUnit))
(T (SETQ TaskResults (CONS (LIST (QUOTE NewUnits)
NewUnit)
TaskResults]
[ADDPROP (QUOTE H13)
(QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(InitializeCreditAssignment)
(LIST (QUOTE WillAvoid)
(QUOTE changing)
(QUOTE a)
CFrom
(QUOTE inside)
(QUOTE the)
CSlot
(QUOTE slot)
(COND ((CDR CSlotSibs)
(LIST (QUOTE ,)
(QUOTE actually)
(QUOTE all)
(QUOTE of)
(QUOTE these:)
CSlotSibs
(QUOTE ,)))
(T (QUOTE ,)))
(QUOTE of)
(QUOTE units)
(QUOTE whenever)
(QUOTE finding)
GSlot
(QUOTE of)
(QUOTE them]
[MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
(FUNCTION (LAMBDA (H)
(ADDPROP H (QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(DecrementCreditAssignment]
(PUT NewUnit (QUOTE Creditors)
(SETQ Creditors (CONS (QUOTE H13)
Creditors)))
T])
(PUTPROPS HAvoid3 IsA (Heuristic Op)
English (IF the current task is to find GSlot of some unit, then and we did that by altering its CSlot slot,
(or ANY of these slots: CSlotSibs)
then make sure we didn't change something into a CTo)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Avoid GSlot created by altering something into a CTo in CSlot slot)
IfAboutToWorkOnTask [LAMBDA (task)
(AND NotForReal (IsAKindOf CurSlot (QUOTE GSlot))
(MEMB (CADR (ASSOC (QUOTE SlotToChange)
CurSup))
(QUOTE CSlotSibs))
(SETQ DoomedU
(SUBSET NewUnits
(FUNCTION
(LAMBDA
(U)
(SOME [CAR (LAST (SOME (Applics (CAR (Creditors U)))
(FUNCTION (LAMBDA
(A)
(MEMB U (CADR A]
(FUNCTION (LAMBDA (Z)
(AND (EQ (CADR Z)
RArrow)
(EQ (CADDR Z)
(QUOTE CTo]
ThenPrintToUser [LAMBDA (C)
(CPRIN1 14 CRLF "Hm; I have had bad experiences in the past trying to find "
(QUOTE GSlot)
" of units by altering their "
(QUOTE CSlot)
"slot, by changing a `"
(QUOTE CFrom)
"' into a `"
(QUOTE CTo)
"', and this is similar; " "I have just killed these units: " DoomedU CRLF]
ThenDeleteOldConcepts [LAMBDA (C)
(MAPC DoomedU (QUOTE KillUnit))
T])
(PUTPROPS HAvoid2 IsA (Heuristic Op)
English (IF the current task is to find GSlot of some unit, then and we did that by altering its CSlot slot,
(or ANY of these slots: CSlotSibs)
then make sure we didn't change a CFrom into anything)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Avoid GSlot created by altering CFrom in CSlot slot)
IfAboutToWorkOnTask [LAMBDA
(task)
(AND NotForReal (IsAKindOf CurSlot (QUOTE GSlot))
(MEMB (CADR (ASSOC (QUOTE SlotToChange)
CurSup))
(QUOTE CSlotSibs))
(SETQ DoomedU
(SUBSET NewUnits
(FUNCTION
(LAMBDA
(U)
(SOME [CAR (LAST (CAR (SOME (Applics (CAR (Creditors U)))
(FUNCTION (LAMBDA
(A)
(MEMB U (CADR A]
(FUNCTION (LAMBDA (Z)
(AND (EQ (CADR Z)
RArrow)
(EQ (CAR Z)
(QUOTE CFrom]
ThenPrintToUser [LAMBDA (C)
(CPRIN1 14 CRLF "Hm; I have had bad experiences in the past trying to find "
(QUOTE GSlot)
" of units by altering their "
(QUOTE CSlot)
"slot, by changing a `"
(QUOTE CFrom)
"' into a `"
(QUOTE CTo)
"', and this is similar; " "I have just killed these units: " DoomedU CRLF]
ThenDeleteOldConcepts [LAMBDA (C)
(MAPC DoomedU (QUOTE KillUnit))
T])
(PUTPROPS HAvoid IsA (Heuristic Op)
English (IF the current task is to find GSlot of some unit, then make sure that the slot to change isn't any
of these: CSlotSibs)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Avoid GSlot created by altering CSlotSibs)
IfAboutToWorkOnTask [LAMBDA (task)
(AND NotForReal (IsAKindOf CurSlot (QUOTE GSlot))
(EQ (CADR (ASSOC (QUOTE SlotToChange)
CurSup))
(QUOTE CSlot]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 14 CRLF "Hm; I have had bad experiences in the past trying to find "
(QUOTE GSlot)
" of units by altering their "
(QUOTE CSlot)
" slot, and this is similar; " " I'm just going to abort this entire task!"
CRLF)
(SETQ AbortTask? (QUOTE AbortTask!])
(PUTPROPS H12 IsA (HindSightRule Heuristic Op)
English (IF C is about to die, then try to form a new heuristic, one which -- had it existed earlier -- would
have prevented C from ever being defined in the first place)
IfPotentiallyRelevant [LAMBDA (f)
(MEMB f DeletedUnits]
Worth 700
Abbrev (Form a rule that would have prevented this mistake)
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF CRLF
"Just before destroying a losing concept, Eurisko generalized from that bad experience, in the following way: "
"Eurisko will no longer alter the " CSlot " slot of a unit "
"when trying to find "
GSlot " of that unit. We learned our lesson from " ArgU CRLF CRLF]
ThenCompute [LAMBDA (C)
(AND [SETQ CSlot
(CADR (ASSOC (QUOTE SlotToChange)
(CAR (CDDDDR (SETQ CTask
(CADDAR (CAR (SOME (Applics (CAR (Creditors C)))
(FUNCTION
(LAMBDA (A)
(MEMB C (CADR A]
(SETQ GSlot (CADDR CTask))
(OR (ILEQ (LENGTH (SETQ CSlotSibs (SibSlots CSlot)))
50)
(SETQ CSlotSibs (LIST CSlot)))
(OR CSlotSibs (SETQ CSlotSibs (LIST CSlot]
ThenDefineNewConcepts [LAMBDA (task)
(SETQ NewUnit (CreateUnit (QUOTE HAvoid)
(QUOTE HAvoid)))
(SETPROPLIST NewUnit (SUBPAIR (QUOTE (GSlot CSlot CSlotSibs NotForReal))
(LIST GSlot CSlot CSlotSibs T)
(GETPROPLIST NewUnit)))
(SETQ NewUnits (CDR (ASSOC (QUOTE NewUnits)
TaskResults)))
[COND (NewUnits (NCONC1 NewUnits NewUnit))
(T (SETQ TaskResults (CONS (LIST (QUOTE NewUnits)
NewUnit)
TaskResults]
[ADDPROP (QUOTE H12)
(QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(InitializeCreditAssignment)
(LIST (QUOTE WillAvoid)
CSlot
(QUOTE slot)
(COND ((CDR CSlotSibs)
(LIST (QUOTE ,)
(QUOTE actually)
(QUOTE all)
(QUOTE of)
(QUOTE these:)
CSlotSibs
(QUOTE ,)))
(T (QUOTE ,)))
(QUOTE of)
(QUOTE units)
(QUOTE whenever)
(QUOTE finding)
GSlot
(QUOTE of)
(QUOTE them]
[MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
(FUNCTION (LAMBDA (H)
(ADDPROP H (QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(DecrementCreditAssignment]
(PUT NewUnit (QUOTE Creditors)
(SETQ Creditors (CONS (QUOTE H12)
Creditors)))
T])
(PUTPROPS HindSightRule Worth 900
IsA (Set)
Generalizations (Op Heuristic)
Abbrev (Heuristic rules for learning from bitter experiences)
Examples (H12 H13 H14))
(PUTPROPS NonCriterialSlot IsA (Set ReprConcept)
Worth 500
Generalizations (Slot)
Examples (Abbrev Applics Arity Creditors DirectApplics DontCopy DoubleCheck English Examples Format
Generalizations InDomainOf IndirectApplics IsA IsRangeOf Range SibSlots
Specializations SubSlots SuperSlots Transpose Worth Inverse))
(PUTPROPS H2 IsA (Heuristic Op)
English (IF you have just finished a task, and some units were created, and one of the creators has the property
of spewing garbage, THEN snuff that spewer)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Kill a concept that leads to lots of garbage)
IfFinishedWorkingOnTask [LAMBDA (task)
(AND (ASSOC (QUOTE NewUnits)
TaskResults)
(SETQ PosCred
(SUBSET (SelfIntersect (MapUnion (CDR (ASSOC (QUOTE NewUnits)
TaskResults))
(FUNCTION Creditors)))
(FUNCTION
(LAMBDA
(C)
(* See if C has generated many concepts none of which have
any decent applics)
(AND (MEMB C NewU)
(IGEQ (LENGTH (Applics C))
10)
(EVERY (Applics C)
(FUNCTION
(LAMBDA
(Z)
(AND (LISTP (CADR Z))
(EVERY (CADR Z)
(FUNCTION
(LAMBDA (A)
(NULL (Applics A]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 14 CRLF CRLF (LENGTH PosCred)
" units were reduced in Worth, due to excessive generation of mediocre concepts by them; namely: "
PosCred CRLF)
(AND DeletedUnits (CPRIN1 14 CRLF CRLF (LENGTH DeletedUnits)
" had Worths that were now so low, the whole concept was obliterated;"
" namely; " DeletedUnits CRLF CRLF))
(SETQ PosCred NIL)
(SETQ DeletedUnits NIL)
T]
ThenCompute [LAMBDA (task)
(AND (BOUNDP (QUOTE PosCred))
(LISTP PosCred)
(OR (MAPC PosCred (QUOTE PunishSeverely))
T)
(SETQ TaskResults
(AddPropL TaskResults (QUOTE PunishedUnits)
(CONS PosCred (QUOTE (because they've led to so many questionable units
being created!]
ThenDeleteOldConcepts [LAMBDA (task)
(SETQ DeletedUnits NIL)
[MAPC PosCred (FUNCTION (LAMBDA (C)
(COND ((ILEQ (Worth C)
175)
(SETQ DeletedUnits (CONS C DeletedUnits))
[MAPC (Examples (QUOTE HindSightRule))
(FUNCTION (LAMBDA (r)
(ApplyRule r C
", before we delete it."]
(KillUnit C]
[AND DeletedUnits (SETQ TaskResults
(AddPropL TaskResults (QUOTE DeletedUnits)
(CONS DeletedUnits
(QUOTE (because their Worth has fallen so
low]
T])
(PUTPROPS ThenDeleteOldConcepts Worth 600
IsA (Slot CriterialSlot)
SuperSlots (ThenParts)
DataType LispFn)
(PUTPROPS TheFirstOf Worth 500
IsA (Op Pred)
FastAlg [LAMBDA (X Y)
X]
Arity 2
Domain (Anything Anything)
Range (Anything)
ElimSlots (Applics)
Generalizations (AND)
Specializations (OR))
(PUTPROPS TheSecondOf Worth 500
IsA (Op Pred)
FastAlg [LAMBDA (X Y)
Y]
Arity 2
Domain (Anything Anything)
Range (Anything)
ElimSlots (Applics)
Generalizations (AND)
Specializations (OR))
(PUTPROPS OR Worth 500
IsA (Op Pred)
FastAlg [LAMBDA (X Y)
(OR X Y]
Arity 2
Domain (Anything Anything)
Range (Anything)
ElimSlots (Applics)
Specializations (AND)
Generalizations (TheSecondOf TheFirstOf))
(PUTPROPS AND Worth 539
IsA (Op Pred)
FastAlg [LAMBDA (X Y)
(AND X Y]
Arity 2
Domain (Anything Anything)
Range (Anything)
ElimSlots (Applics)
Generalizations (OR)
Specializations (TheSecondOf TheFirstOf))
(PUTPROPS Abbrev Worth 303
IsA (Slot NonCriterialSlot)
DataType Text)
(PUTPROPS Add Worth 500
IsA (MathConcept MathOp Op NumOp)
FastAlg [LAMBDA (X Y)
(PLUS X Y]
RecursiveAlg [LAMBDA (X Y)
(COND ((EQ X 0)
Y)
(T (RunAlg (QUOTE Successor)
(RunAlg (QUOTE Add)
(SUB1 X)
Y]
UnitizedAlg [LAMBDA (X Y)
(COND ((EQ X 0)
Y)
(T (RunAlg (QUOTE Successor)
(RunAlg (QUOTE Add)
(SUB1 X)
Y]
IterativeAlg [LAMBDA (X Y)
(for i from 1 to X do (SETQ Y (ADD1 Y)))
Y]
Arity 2
Domain (NNumber NNumber)
Range (NNumber)
ElimSlots (Applics))
(PUTPROPS Alg Worth 600
IsA (Slot CriterialSlot)
DataType LispFn
SubSlots (FastAlg IterativeAlg RecursiveAlg UnitizedAlg))
(PUTPROPS Anything Worth 550
Specializations (MathConcept ReprConcept)
IsA (Set)
IsRangeOf (RandomChoose GoodChoose BestChoose AND OR TheSecondOf TheFirstOf)
InDomainOf (EQUAL EQ AND OR TheSecondOf TheFirstOf))
(PUTPROPS ApplicGenerator Worth 600
IsA (Slot CriterialSlot)
DataType LispFn
Format (ApplicGenInit ApplicGenBuild ApplicGenArgs))
(PUTPROPS Applics Worth 302
IsA (Slot NonCriterialSlot)
Format ((situation resultant-units directness)
(situation resultant-units directness)
etc.)
DataType IOPair
SubSlots (DirectApplics IndirectApplics)
DoubleCheck T
DontCopy T)
(PUTPROPS Arity Worth 300
IsA (Slot NonCriterialSlot)
DataType Number)
(PUTPROPS BestChoose Worth 500
IsA (MathConcept MathOp Op SetOp)
FastAlg [LAMBDA (L)
(MAXIMUM (SUBSET L (QUOTE Unitp))
(QUOTE Worth]
Domain (Set)
Range (Anything)
Generalizations (RandomChoose GoodChoose)
ElimSlots (Applics))
(PUTPROPS BestSubset Worth 500
IsA (MathConcept MathOp Op SetOp)
FastAlg [LAMBDA (L)
(DREVERSE (NTH (SortByWorths (APPEND L))
(RAND 0 (LENGTH L]
Domain (Set)
Range (Set)
Generalizations (RandomSubset GoodSubset)
ElimSlots (Applics))
(PUTPROPS Bit IsRangeOf (EQUAL IEQP EQ ILEQ IGEQ ILESSP IGREATERP)
Worth 500
IsA (Set MathConcept MathObj)
Examples (T NIL)
FastDefn [LAMBDA (B)
(OR (EQ B NIL)
(EQ B T])
(PUTPROPS CompiledDefn SuperSlots (Defn)
Worth 600
IsA (Slot CriterialSlot)
DataType CompiledLispCode)
(PUTPROPS Conjecture Worth 500
Examples (ProtoConjec)
IsA (Set))
(PUTPROPS Creditors ToDelete1 [LAMBDA (U1 P U2)
(* U1 is on the P property of unit U2, and is now being deleted. We must remove
accreditaion of U2 from the Applics slot of U1)
(REM1PROP U1 (QUOTE Applics)
(CAR (SOME (Applics U1)
(FUNCTION (LAMBDA (a)
(EQ (CAADR a)
U2]
Worth 300
IsA (Slot NonCriterialSlot)
DataType Unit)
(PUTPROPS CriterialSlot IsA (Set ReprConcept)
Worth 500
Generalizations (Slot)
Examples (Alg ApplicGenerator CompiledDefn DataType Defn Domain ElimSlots FastAlg FastDefn Generator
IfAboutToWorkOnTask IfFinishedWorkingOnTask IfParts IfPotentiallyRelevant IfTaskParts
IfTrulyRelevant IfWorkingOnTask IterativeAlg IterativeDefn NonExamples RecursiveAlg
RecursiveDefn ThenAddToAgenda ThenCompute ThenConjecture ThenDefineNewConcepts
ThenModifySlots ThenParts ThenPrintToUser ToDelete ToDelete1 UnitizedAlg UnitizedDefn
ThenDeleteOldConcepts))
(PUTPROPS DataType Worth 600
IsA (Slot CriterialSlot)
DataType DataType
DoubleCheck T)
(PUTPROPS Defn Worth 600
IsA (Slot CriterialSlot)
DataType LispPred
SubSlots (CompiledDefn FastDefn IterativeDefn RecursiveDefn UnitizedDefn))
(PUTPROPS DirectApplics Worth 300
IsA (Slot NonCriterialSlot)
Format ((situation resultant-units directness)
(situation resultant-units directness)
etc.)
DataType IOPair
SuperSlots (Applics)
DoubleCheck T
DontCopy T)
(PUTPROPS DivisorsOf Worth 500
IsA (MathConcept MathOp Op NumOp)
FastAlg [LAMBDA (n)
(SORT (PROG ((i 1)
divi)
LOOP
(COND ((GREATERP (SQUARE i)
n)
(RETURN divi)))
[COND ((Divides i n)
(SETQ divi (CONS i (CONS (QUOTIENT n i)
divi]
(SETQ i (ADD1 i))
(GO LOOP]
IterativeAlg [LAMBDA (n)
(for i from 1 to n collect i when (Divides i n]
Domain (NNumber)
Range (SetOfNumbers)
ElimSlots (Applics))
(PUTPROPS Domain Worth 600
IsA (Slot CriterialSlot)
DataType Unit
Inverse (InDomainOf))
(PUTPROPS DontCopy Worth 300
IsA (Slot NonCriterialSlot)
DataType Bit)
(PUTPROPS DoubleCheck Worth 300
IsA (Slot NonCriterialSlot)
DataType Bit)
(PUTPROPS EQ Worth 500
IsA (MathConcept MathOp Op MathPred Pred)
FastAlg [LAMBDA (X Y)
(EQ X Y]
Arity 2
Domain (Anything Anything)
Range (Bit)
Generalizations (EQUAL)
ElimSlots (Applics))
(PUTPROPS EQUAL Worth 500
IsA (MathConcept MathOp Op MathPred Pred)
FastAlg [LAMBDA (X Y)
(EQUAL X Y]
Arity 2
Domain (Anything Anything)
Range (Bit)
Specializations (IEQP EQ)
ElimSlots (Applics))
(PUTPROPS ElimSlots Worth 600
IsA (Slot CriterialSlot)
DataType Slot
DoubleCheck T)
(PUTPROPS English Worth 302
IsA (Slot NonCriterialSlot)
DataType Text)
(PUTPROPS EvenNum Generalizations (NNumber)
Worth 800
UnitizedDefn [LAMBDA (n)
(RunAlg (QUOTE Divides)
2 n]
IsA (Set MathConcept MathObj)
FastDefn [LAMBDA (n)
(Divides 2 n]
ElimSlots (Examples))
(PUTPROPS Examples Worth 300
IsA (Slot NonCriterialSlot)
Inverse (IsA)
DataType Unit
DoubleCheck T
DontCopy T)
(PUTPROPS FastAlg SuperSlots (Alg)
IsA (Slot CriterialSlot)
Worth 600
DataType LispFn)
(PUTPROPS FastDefn SuperSlots (Defn)
Worth 600
IsA (Slot CriterialSlot)
DataType LispPred)
(PUTPROPS Format Worth 300
IsA (Slot NonCriterialSlot)
DataType DataType)
(PUTPROPS Generalizations Worth 300
IsA (Slot NonCriterialSlot)
SubSlots (SuperSlots)
Inverse (Specializations)
DataType Unit
DoubleCheck T)
(PUTPROPS Generator Worth 600
IsA (Slot CriterialSlot)
DataType LispFn
Format (GenInit GenBuild GenArgs))
(PUTPROPS GoodChoose Worth 500
IsA (MathConcept MathOp Op SetOp)
FastAlg [LAMBDA (L)
(CAR (SOME (SortByWorths (APPEND L))
(QUOTE RandomP]
Domain (Set)
Range (Anything)
Generalizations (RandomChoose)
Specializations (BestChoose)
ElimSlots (Applics))
(PUTPROPS GoodSubset Worth 500
IsA (MathConcept MathOp Op SetOp)
FastAlg [LAMBDA (L)
(RandomSubset (BestSubset L]
Domain (Set)
Range (Set)
Generalizations (RandomSubset)
Specializations (BestSubset)
ElimSlots (Applics))
(PUTPROPS H1 IsA (Heuristic Op)
English (IF the results of performing f are only occasionally useful , THEN consider creating new specializations
of f)
IfPotentiallyRelevant [LAMBDA (f)
(* check that f has some recorded applications -- which implies, of course, that f
is an executable/performable entity)
(Applics f]
IfTrulyRelevant [LAMBDA (f)
(* check that some Applics of f have high Worth, but most have low Worth)
(* the extent to which those conditions are met will determine the amount of energy to
expend working on applying this rule -- its overall relevancy)
(AND [SOME (Applics f)
(QUOTE (LAMBDA (a)
(* this will have the format (args results))
(SOME (CADR a)
(QUOTE HasHighWorth]
(GREATERP .2 (SETQ Fraction (FractionOf (MapUnion (Applics f)
(QUOTE CADR))
(QUOTE HasHighWorth]
Worth 708
Applics (((sit1)
(win1 los1))
((sit2)
(los2 los3 los4 los5 los6)))
Abbrev (Specialize a sometimes-useful action)
ThenPrintToUser [LAMBDA (f)
(CPRIN1 13 "
" conjec ":" "
Since some specializations of " f " " (CONS "i.e., " (Abbrev f))
" are quite valuable, but over four-fifths are trash, EURISKO has recognized the value of finding new concepts similar to -- but more specialized than -- "
f
", and (to that end) has added a new task to the agenda to find such specializations. ")
T]
ThenConjecture [LAMBDA (f)
(SETQ Conjectures
(CONS (PROGN (SETQ conjec (NewNam (QUOTE Conjec)))
(CreateUnit conjec (QUOTE ProtoConjec))
[PUT conjec (QUOTE English)
(NCONC (LIST (QUOTE Specializations)
(QUOTE of)
f)
(APPEND (QUOTE (may be more useful than it is, since it has
some good instances but many more poor
ones)))
(LIST (LIST (Percentify (DIFFERENCE 1.0 Fraction))
(QUOTE are)
(QUOTE losers]
[PUT conjec (QUOTE Abbrev)
(CONS f
(QUOTE (sometimes wins, usually loses, so specializations of
it may win big]
[PUT conjec (QUOTE Worth)
(FIX (Average (NearnessTo Fraction .1)
(AverageWorths (QUOTE H1)
f]
conjec)
Conjectures]
ThenAddToAgenda [LAMBDA (f)
(SETQ Agenda (MergeTasks [LIST (LIST (AverageWorths f (QUOTE H1))
f
(QUOTE Specializations)
(LIST conjec)
(LIST (LIST (QUOTE CreditTo)
(QUOTE H1]
Agenda))
(AddPropL TaskResults (QUOTE NewTasks)
(QUOTE (1 unit must be specialized])
(PUTPROPS H10 IsA (Heuristic Op)
English (IF the current task is to find examples of a unit, and it is the range of some operation f, THEN gather
together the outputs of the I/O pairs stored on Applics of f)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (If C is Range (f)
, then Exs (C)
can be gotten from Applics (f))
IfWorkingOnTask [LAMBDA (task)
(AND (EQ CurSlot (QUOTE Examples))
(SETQ OpToUse (RandomChoose (IsRangeOf CurUnit]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Instantiated " CurUnit "; there are now " (LENGTH (Examples CurUnit))
" "
(QUOTE Examples)
CRLF)
(CPRIN1 48 " Namely: " (Examples CurUnit)
CRLF)
T]
ThenCompute [LAMBDA (task)
[AND (SETQ SpaceToUse (Applics OpToUse))
(MAPC SpaceToUse (FUNCTION (LAMBDA (Z)
(SETQ Z (ExtractOutput Z))
(AND (NOT (MEMBER Z (Examples CurUnit)))
(NOT (MEMBER Z (NonExamples CurUnit)))
(CPRIN1 58 (QUOTE +))
(UnionProp CurUnit (QUOTE Examples)
Z]
(AND (Examples CurUnit)
(SETQ TaskResults (CONS (LIST (QUOTE NewValues)
(LIST CurUnit CurSlot (Examples CurUnit)
(LIST (QUOTE By)
(QUOTE examining)
(QUOTE Applics)
(QUOTE of)
OpToUse
(QUOTE ,)
(QUOTE Eurisko)
(QUOTE found)
(LENGTH (Examples CurUnit))
(QUOTE Examples)
(QUOTE of)
CurUnit)))
TaskResults)))
(* this always returns T ; if the SpaceToUse was null, then ThenAddToAgenda will want to add
a task to the agenda to help correct that situation)
T]
ThenAddToAgenda [LAMBDA (task)
(COND (SpaceToUse (* There were some Applics of OpToUse)
T)
(T (SETQ Agenda
(MergeTasks (LIST [LIST (SUB1 CurPri)
OpToUse
(QUOTE Applics)
[LIST (SUBST CurUnit (QUOTE CU)
(QUOTE (Recent task was stymied for
lack of such applics;
namely, trying to find
Examples of CU]
(LIST (LIST (QUOTE CreditTo)
(QUOTE H10]
(LIST (IQUOTIENT CurPri 2)
CurUnit CurSlot (CONS (LIST (QUOTE Had)
(QUOTE to)
(QUOTE suspend)
(QUOTE whilst)
(QUOTE gathering)
(QUOTE Applics)
(QUOTE of)
OpToUse)
CurReasons)
CurSup))
Agenda))
[SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
(LIST 1 (QUOTE task)
(QUOTE to)
(QUOTE find)
(QUOTE Applics)
(QUOTE of)
OpToUse
(QUOTE and)
1
(QUOTE task)
(QUOTE just)
(QUOTE like)
(QUOTE the)
(QUOTE current)
(QUOTE one]
(CPRIN1 40 CRLF "Hmmm... can't proceed with this until some Applics of " OpToUse
" are known."
CRLF)
NIL])
(PUTPROPS H11 IsA (Heuristic Op)
English (IF the current task is to find application-instances of a unit f, and it has an Algorithm for computing
its values, and it has a Domain, THEN choose examples of its domain component/s, and run the alg for
f on such inputs)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Applics (f)
may be found by running Alg (f)
on members of u's Domain)
IfWorkingOnTask [LAMBDA (task)
(AND (EQ CurSlot (QUOTE Applics))
(SETQ AlgToUse (Alg CurUnit))
(SETQ SpaceToUse (Domain CurUnit]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Instantiated " CurUnit "; found " (LENGTH (Applics CurUnit))
" "
(QUOTE Applics)
CRLF)
(CPRIN1 48 " Namely: " (Applics CurUnit)
CRLF)
T]
ThenCompute [LAMBDA (task Args Failed)
[* (PUTD (QUOTE APPLYTOUSE)
(GETD (COND ((AND (Arity CurUnit)
(IGREATERP (Arity CurUnit)
1))
(QUOTE APPLY))
(T (QUOTE APPLY*]
(SETQ DomainTests (MAPCAR (Domain CurUnit)
(QUOTE Defn)))
[SELECTQ (LENGTH DomainTests)
[0 (for j from 1 to 100 do (AND (NOT (KnownApplic CurUnit NIL))
(CPRIN1 62 (QUOTE +))
(UnionProp CurUnit (QUOTE Applics)
(LIST NIL (APPLY* AlgToUse NIL]
(1 (MapExamples (CAR (Domain CurUnit))
[FUNCTION (LAMBDA (A)
(AND (NOT (KnownApplic CurUnit (LIST A)))
(APPLY* (CAR DomainTests)
A)
(CPRIN1 62 (QUOTE +))
(UnionProp CurUnit (QUOTE Applics)
(LIST (LIST A)
(APPLY* AlgToUse A]
200))
(for j from 1 to 100 do
(AND [SETQ Args (MAPCAR SpaceToUse
(FUNCTION (LAMBDA
(D)
(COND
((Examples D)
(RandomChoose (Examples D)))
((Generator D)
(PROG (lastgen)
(MapExamples
D
(FUNCTION [LAMBDA (E)
(SETQ lastgen
E])
(RAND 1 200))
(RETURN lastgen)))
(T (SETQ Failed T)
NIL]
(NOT Failed)
(NOT (KnownApplic CurUnit Args))
(for DT in DomainTests as A in Args always (APPLY* DT A))
(CPRIN1 62 (QUOTE +))
(UnionProp CurUnit (QUOTE Applics)
(LIST Args (CAR (ERRORSET (QUOTE (APPLY AlgToUse Args))
(QUOTE NOBREAK]
(AND (Applics CurUnit)
(SETQ TaskResults (CONS [LIST (QUOTE NewValues)
(LIST CurUnit CurSlot (Applics CurUnit)
(LIST (QUOTE By)
(QUOTE running)
(QUOTE algorithm)
(QUOTE for)
CurUnit
(QUOTE on)
(QUOTE random)
(QUOTE examples)
(QUOTE from)
(Domain CurUnit)
(QUOTE ,)
(LENGTH (Applics CurUnit))
(QUOTE were)
(QUOTE found]
TaskResults])
(PUTPROPS H3 IsA (Heuristic Op)
English (IF the current task is to specialize a unit, and no specific slot has been chosen to be the one changed,
THEN randomly select a slot to specialize)
IfPotentiallyRelevant NULL
Worth 704
Applics (((sit1)
(win1 los1)))
Abbrev (Specialize u by specializing one random slot)
IfAboutToWorkOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (QUOTE Specializations))
(NULL (ASSOC (QUOTE SlotToChange)
CurSup]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF NewReason CRLF CRLF)
T]
ThenAddToAgenda [LAMBDA (task)
(SETQ Agenda (MergeTasks [LIST (LIST (Average CurPri (AverageWorths CurUnit (QUOTE H3)))
CurUnit CurSlot
(CONS (SETQ NewReason
(LIST
"A new unit will be created by specializing the "
SlotToChange " slot of " CurUnit
"; that slot was chosen randomly."))
CurReasons)
(LIST (LIST (QUOTE SlotToChange)
SlotToChange)
(CONS (QUOTE CreditTo)
(CONS (QUOTE H3)
CreditTo]
Agenda))
(SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
(LIST 1 (QUOTE specific)
(QUOTE slot)
(QUOTE of)
CurUnit
(QUOTE to)
(QUOTE find)
CurSlot
(QUOTE of]
ThenCompute [LAMBDA (task)
[SETQ SlotToChange (RandomChoose (SetIntersect (SlotNames CurUnit)
(Examples (QUOTE Slot]
(SETQ CreditTo (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
T])
(PUTPROPS H4 IsA (Heuristic Op)
English (IF a new unit has just been synthesized, THEN its a good idea to find instances of it)
IfPotentiallyRelevant NULL
Worth 701
Applics (((sit1)
(win1 los1)))
Abbrev (Plan to gather empirical data about new concepts)
IfFinishedWorkingOnTask [LAMBDA (task)
(SETQ NewUnits (CDR (ASSOC (QUOTE NewUnits)
TaskResults]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF (LENGTH NewUnits)
" new units ")
(CPRIN1 33 ", namely " NewUnits ", ")
(CPRIN1 13
"were defined. New tasks are being added to the agenda to ensure that empirical data about them will soon be gathered. "
CRLF CRLF)
T]
ThenAddToAgenda [LAMBDA (task)
(SETQ Agenda (MergeTasks [MAPCAR NewUnits (FUNCTION (LAMBDA (NewUnit)
(LIST (AverageWorths
NewUnit
(QUOTE H4))
NewUnit
(Instances NewUnit)
(LIST
"After a unit is synthesized, it is useful to seek instances of it.")
(LIST (QUOTE CreditTo)
(QUOTE H4]
Agenda))
(SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
(CONS (LENGTH NewUnits)
(QUOTE (new units must have instances found])
(PUTPROPS H5 IsA (Heuristic Op)
English (IF the current task is to specialize a unit, and no specific slot has been chosen to be the one changed,
THEN randomly select which slots to specialize)
IfPotentiallyRelevant NULL
Worth 705
Applics (((sit1)
(win1 los1)))
Abbrev (Specialize u by specializing some random slots)
IfAboutToWorkOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (QUOTE Specializations))
(NULL (ASSOC (QUOTE SlotToChange)
CurSup]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF CurUnit
" will be specialized by specializing the following of its slots: "
SlotsToChange CRLF CRLF)
T]
ThenAddToAgenda [LAMBDA (task)
(SETQ Agenda (MergeTasks (SORT [MAPCAR SlotsToChange
(FUNCTION
(LAMBDA (S)
(LIST (Average CurPri
(AverageWorths
S
(QUOTE H5)))
CurUnit CurSlot
(CONS (SETQ NewReason
(LIST
"A new unit will be created by specializing the "
S " slot of "
CurUnit
"; that slot was chosen randomly."))
CurReasons)
(LIST (LIST (QUOTE SlotToChange)
S)
(CONS (QUOTE CreditTo)
(CONS (QUOTE H5)
CreditTo]
(QUOTE OrderTasks))
Agenda))
(SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
(LIST (LENGTH SlotsToChange)
(QUOTE specific)
(QUOTE slots)
(QUOTE of)
CurUnit
(QUOTE to)
(QUOTE find)
CurSlot
(QUOTE of]
ThenCompute [LAMBDA (task)
[SETQ SlotsToChange (RandomSubset (SetIntersect (SlotNames CurUnit)
(Examples (QUOTE Slot]
(SETQ CreditTo (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
T])
(PUTPROPS H6 IsA (Heuristic Op)
English (IF the current task is to specialize a unit, and a slot has been chosen to be the one changed, THEN
randomly select a part of it and specialize that part)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Specialize a given slot of a given unit)
IfWorkingOnTask [LAMBDA (task)
(AND (IsAKindOf CurSlot (QUOTE Specializations))
(SETQ SlotToChange (CADR (ASSOC (QUOTE SlotToChange)
CurSup]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Specialized the " SlotToChange " slot of " CurUnit
", replacing its old value ")
(CPRIN1 48 "(which was " OldValue ") ")
(CPRIN1 14 "by " NewValue "." CRLF)
(CPRIN1 13 CRLF)
T]
ThenCompute [LAMBDA (task)
(* assumes the existence of functions SpecializeLispPred SpecializeLispFn SpecializeList and
of course SpecializeNIL to catch the slots which have not DataType slot)
(SETQ UDiff NIL)
(SETQ AreUnits NIL)
(SETQ HaveSpec NIL)
[SETQ NewValue (APPLY* (PACK* (QUOTE Specialize)
(DataType SlotToChange))
(SETQ OldValue (APPLY* SlotToChange CurUnit]
(SETQ NeedSpec (SetDiff AreUnits HaveSpec))
(* If the OldValue and NewValue are equal, then we really haven't specialized it at all, so we
want to return NIL and have this rule FAIL)
(MAPC HaveSpec (QUOTE TinyReward))
[AND HaveSpec (SETQ TaskResults
(AddPropL TaskResults (QUOTE RewardedUnits)
(CONS HaveSpec
(APPEND (QUOTE (because they could have been used in
specializing))
(LIST CurUnit]
(SETQ Agenda
(MergeTasks [MAPCAR NeedSpec
(FUNCTION (LAMBDA (ns)
(LIST (Half CurPri)
ns
(QUOTE Specializations)
[LIST (CONS CurUnit
(APPEND (QUOTE (might have been
specialized
better,
earlier, if
some
specializations had
existed for)
)
(LIST ns]
(LIST (LIST (QUOTE CreditTo)
(QUOTE H6]
Agenda))
[AND NeedSpec
(SETQ TaskResults
(AddPropL TaskResults (QUOTE NewTasks)
(CONS NeedSpec
(APPEND (QUOTE (will be specialized, because if such
specializations had existed, we could have
used them just now while trying to specialize))
(LIST CurUnit]
(COND ((EQUAL OldValue NewValue)
(CPRIN1 15 CRLF "Hmmm... couldn't seem to find any meaningful specialization of the "
SlotToChange " slot of " CurUnit CRLF)
NIL)
((IGREATERP Verbosity 15)
(CPRIN1 15 CRLF "Inside the " SlotToChange " slot, ")
(MAPRINT UDiff)
(TERPRI)
T)
(T T]
ThenDefineNewConcepts [LAMBDA (task)
(SETQ NewUnit (CreateUnit CurUnit CurUnit))
[MAPC (SibSlots SlotToChange)
(FUNCTION (LAMBDA (S)
(KillSlot NewUnit S]
(PUT NewUnit SlotToChange NewValue)
(SETQ NewUnits (CDR (ASSOC (QUOTE NewUnits)
TaskResults)))
[COND (NewUnits (NCONC1 NewUnit NewUnits))
(T (SETQ TaskResults (CONS (LIST (QUOTE NewUnits)
NewUnit)
TaskResults]
(ADDPROP (QUOTE H6)
(QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(InitializeCreditAssignment)
(LIST (QUOTE Specialized)
SlotToChange
(QUOTE slot)
(QUOTE of)
CurUnit
(QUOTE as)
(QUOTE follows:)
UDiff)))
[MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
CurSup)))
(FUNCTION (LAMBDA (H)
(ADDPROP H (QUOTE Applics)
(LIST (LIST (QUOTE TaskNum:)
TaskNum task (DATE))
(LIST NewUnit)
(DecrementCreditAssignment]
(PUT NewUnit (QUOTE Creditors)
(SETQ Creditors (CONS (QUOTE H6)
Creditors)))
(ADDPROP CurUnit (QUOTE Specializations)
NewUnit)
(ADDPROP NewUnit (QUOTE Generalizations)
CurUnit)
T])
(PUTPROPS H7 IsA (Heuristic Op)
English (IF a concept has no known instances, THEN try to find some)
IfPotentiallyRelevant [LAMBDA (f)
(* check that f has some recorded applications -- which implies, of course, that f
is an executable/performable entity)
(NULL (APPLY* (Instances f)
f]
IfTrulyRelevant [LAMBDA (f)
(OR (MEMB (QUOTE Set)
(IsA f))
(MEMB (QUOTE Op)
(IsA f]
Worth 700
Abbrev (Instantiate a concept having no known instances)
ThenPrintToUser [LAMBDA (f)
(CPRIN1 13 CRLF "Since " f " has no known " (Instances f)
", it is probably worth looking for some." CRLF)
T]
ThenAddToAgenda [LAMBDA (f)
(SETQ Agenda
(MergeTasks [LIST (LIST (AverageWorths f (QUOTE H7))
f
(Instances f)
[LIST (SUBST f (QUOTE f)
(QUOTE (To properly study f we must gather
empirical data about instances of
that concept]
(LIST (LIST (QUOTE CreditTo)
(QUOTE H7]
Agenda))
(AddPropL TaskResults (QUOTE NewTasks)
(QUOTE (1 unit must be instantiated])
(PUTPROPS H8 IsA (Heuristic Op)
English (IF the current task is to find application-instances of a unit, and it has a algorithm, THEN look over
instances of generalizations of the unit, and see if any of them are valid application-instances of
this as well)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Applics (u)
may be found amongst Applics (Genl (u)))
IfWorkingOnTask [LAMBDA (task)
(AND (EQ CurSlot (QUOTE Applics))
(SETQ AlgToUse (Alg CurUnit))
(SETQ SpaceToUse (SetDiff [OR (Generalizations CurUnit)
(SelfIntersect (MAPAPPEND (IsA CurUnit)
(QUOTE Examples]
(CONS CurUnit (Specializations CurUnit]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Instantiated " CurUnit "; found " (LENGTH (Applics CurUnit))
" "
(QUOTE Applics)
CRLF)
(CPRIN1 48 " Namely: " (Applics CurUnit)
CRLF)
T]
ThenCompute [LAMBDA (task DomainTests)
[* (PUTD (QUOTE APPLYTOUSE)
(GETD (COND ((AND (Arity CurUnit)
(IGREATERP (Arity CurUnit)
1))
(QUOTE APPLY))
(T (QUOTE APPLY*]
(SETQ DomainTests (MAPCAR (Domain CurUnit)
(QUOTE Defn)))
[MAPC SpaceToUse (FUNCTION (LAMBDA (Z)
(MapApplics Z
[FUNCTION
(LAMBDA
(I TEMP)
(AND (NOT (KnownApplic CurUnit
(ApplicArgs I)))
(EQUAL (LENGTH DomainTests)
(ApplicArgs I))
(for DT in DomainTests as A in
(ApplicArgs I)
always
(APPLY* DT A))
(SETQ
TEMP
(ERRORSET
(QUOTE (APPLY AlgToUse
(ApplicArgs I)))
(QUOTE NOBREAK)))
(UnionProp CurUnit (QUOTE Applics)
(LIST (ApplicArgs I)
(CAR TEMP]
100]
(AND (Applics CurUnit)
(SETQ TaskResults (CONS (LIST (QUOTE NewValues)
(LIST CurUnit CurSlot (Applics CurUnit)
(LIST (QUOTE By)
(QUOTE examining)
(QUOTE Applics)
(QUOTE of)
SpaceToUse
(QUOTE ,)
(QUOTE Eurisko)
(QUOTE found)
(LENGTH (Applics CurUnit))
(QUOTE of)
(QUOTE them)
(QUOTE were)
(QUOTE also)
(QUOTE Applics)
(QUOTE of)
CurUnit)))
TaskResults])
(PUTPROPS H9 IsA (Heuristic Op)
English (IF the current task is to find examples of a unit, and it has a definition, THEN look over instances of
generalizations of the unit, and see if any of them are valid examples of this as well)
IfPotentiallyRelevant NULL
Worth 700
Abbrev (Exs (u)
may be found amongst Exs (Genl (u)))
IfWorkingOnTask [LAMBDA (task)
(AND (EQ CurSlot (QUOTE Examples))
(SETQ DefnToUse (Defn CurUnit))
(SETQ SpaceToUse (SetDiff [OR (Generalizations CurUnit)
(SelfIntersect (MAPAPPEND (IsA CurUnit)
(QUOTE Examples]
(CONS CurUnit (Specializations CurUnit]
ThenPrintToUser [LAMBDA (task)
(CPRIN1 13 CRLF "Instantiated " CurUnit "; found " (LENGTH (Examples CurUnit))
" "
(QUOTE Examples)
CRLF)
(CPRIN1 48 " Namely: " (Examples CurUnit)
CRLF)
T]
ThenCompute [LAMBDA (task)
[MAPC SpaceToUse (FUNCTION (LAMBDA (Z)
(MapExamples Z [FUNCTION
(LAMBDA (I)
(* If the proposed example is
already on Examples, or already
on NonExamples, then we can stop
immediately)
(AND (NOT (MEMBER I (Examples
CurUnit)))
(NOT (MEMBER I (NonExamples
CurUnit)))
(COND
((APPLY* DefnToUse I)
(CPRIN1 57 (QUOTE +))
T)
(T (CPRIN1 59 (QUOTE -))
NIL))
(UnionProp CurUnit
(QUOTE Examples)
I]
400]
(AND (Examples CurUnit)
(SETQ TaskResults (CONS (LIST (QUOTE NewValues)
(LIST CurUnit CurSlot (Examples CurUnit)
(LIST (QUOTE By)
(QUOTE examining)
(QUOTE Examples)
(QUOTE of)
SpaceToUse
(QUOTE ,)
(QUOTE Eurisko)
(QUOTE found)
(LENGTH (Examples CurUnit))
(QUOTE of)
(QUOTE them)
(QUOTE were)
(QUOTE also)
(QUOTE Examples)
(QUOTE of)
CurUnit)))
TaskResults])
(PUTPROPS Heuristic Worth 900
Examples (H1 H5 H6 H3 H4 H7 H8 H9 H10 H11 H2 H12 HAvoid H3-11 HAvoid2 HAvoid3 H13 H14)
IsA (Set)
Generalizations (Op)
Specializations (HindSightRule))
(PUTPROPS IEQP Worth 500
IsA (MathConcept MathOp Op MathPred Pred)
FastAlg [LAMBDA (X Y)
(IEQP X Y]
Arity 2
Domain (NNumber NNumber)
Range (Bit)
Generalizations (EQUAL ILEQ IGEQ)
ElimSlots (Applics))
(PUTPROPS IGEQ Worth 500
IsA (MathConcept MathOp Op MathPred Pred)
FastAlg [LAMBDA (X Y)
(IGEQ X Y]
Arity 2
Domain (NNumber NNumber)
Range (Bit)
Specializations (IEQP IGREATERP)
Transpose (ILEQ)
ElimSlots (Applics))
(PUTPROPS IGREATERP Worth 500
IsA (MathConcept MathOp Op MathPred Pred)
FastAlg [LAMBDA (X Y)
(IGREATERP X Y]
Arity 2
Domain (NNumber NNumber)
Range (Bit)
Generalizations (IGEQ)
Transpose (ILESSP)
ElimSlots (Applics))
(PUTPROPS ILEQ Worth 500
IsA (MathConcept MathOp Op MathPred Pred)
FastAlg [LAMBDA (X Y)
(ILEQ X Y]
Arity 2
Domain (NNumber NNumber)
Range (Bit)
Specializations (IEQP ILESSP)
Transpose (IGEQ)
ElimSlots (Applics))
(PUTPROPS ILESSP Worth 500
IsA (MathConcept MathOp Op MathPred Pred)
FastAlg [LAMBDA (X Y)
(ILESSP X Y]
Arity 2
Domain (NNumber NNumber)
Range (Bit)
Generalizations (ILEQ)
Transpose (IGREATERP)
ElimSlots (Applics))
(PUTPROPS IfAboutToWorkOnTask Worth 600
IsA (Slot CriterialSlot)
SuperSlots (IfParts)
DataType LispPred)
(PUTPROPS IfFinishedWorkingOnTask Worth 600
IsA (Slot CriterialSlot)
SuperSlots (IfTaskParts)
DataType LispPred)
(PUTPROPS IfParts Worth 600
SubSlots (IfPotentiallyRelevant IfTrulyRelevant IfAboutToWorkOnTask IfWorkingOnTask)
IsA (Slot CriterialSlot)
DataType LispPred)
(PUTPROPS IfPotentiallyRelevant Worth 600
IsA (Slot CriterialSlot)
SuperSlots (IfParts)
DataType LispPred)
(PUTPROPS IfTaskParts Worth 600
IsA (Slot CriterialSlot)
SubSlots (IfAboutToWorkOnTask IfWorkingOnTask IfFinishedWorkingOnTask)
DataType LispPred)
(PUTPROPS IfTrulyRelevant Worth 600
IsA (Slot CriterialSlot)
SuperSlots (IfParts)
DataType LispPred)
(PUTPROPS IfWorkingOnTask Worth 600
IsA (Slot CriterialSlot)
SuperSlots (IfParts)
DataType LispPred)
(PUTPROPS InDomainOf Inverse (Domain)
IsA (Slot NonCriterialSlot)
Worth 300
DataType Unit)
(PUTPROPS IndirectApplics Worth 300
IsA (Slot NonCriterialSlot)
Format ((situation resultant-units directness)
(situation resultant-units directness)
etc.)
DataType IOPair
SuperSlots (Applics)
DoubleCheck T
DontCopy T)
(PUTPROPS Inverse Worth 600
IsA (Slot NonCriterialSlot)
Inverse (Inverse)
DataType Slot
DoubleCheck T)
(PUTPROPS IsA Worth 300
IsA (Slot NonCriterialSlot)
Inverse (Examples)
DataType Unit
DoubleCheck T)
(PUTPROPS IsRangeOf Worth 300
IsA (Slot NonCriterialSlot)
DataType Unit
Inverse (Range))
(PUTPROPS IterativeAlg SuperSlots (Alg)
IsA (Slot CriterialSlot)
Worth 600
DataType LispFn)
(PUTPROPS IterativeDefn SuperSlots (Defn)
Worth 600
IsA (Slot CriterialSlot)
DataType LispPred)
(PUTPROPS MathConcept Generalizations (Anything)
Worth 500
Examples (NNumber PrimeNum PerfNum PerfSquare OddNum EvenNum Square DivisorsOf Multiply Add Successor Set
SetOfNumbers RandomChoose RandomSubset GoodChoose BestChoose BestSubset GoodSubset Bit
EQUAL IEQP EQ ILEQ IGEQ ILESSP IGREATERP)
Specializations (MathOp MathObj SetOp UnitOp NumOp MathPred)
IsA (Set))
(PUTPROPS MathObj Generalizations (MathConcept)
Worth 500
Examples (NNumber PrimeNum PerfNum PerfSquare OddNum EvenNum Set SetOfNumbers Bit)
IsA (Set))
(PUTPROPS MathOp Generalizations (MathConcept Op)
Worth 500
Examples (DivisorsOf Square Multiply Add Successor RandomChoose RandomSubset GoodChoose BestChoose BestSubset
GoodSubset EQUAL IEQP EQ ILEQ IGEQ ILESSP IGREATERP)
IsA (Set)
Specializations (SetOp UnitOp NumOp))
(PUTPROPS MathPred Generalizations (MathConcept Op Pred)
Worth 500
IsA (Set)
Examples (EQUAL IEQP EQ ILEQ IGEQ ILESSP IGREATERP))
(PUTPROPS Multiply Worth 500
IsA (MathConcept MathOp Op NumOp)
FastAlg [LAMBDA (X Y)
(TIMES X Y]
RecursiveAlg [LAMBDA (X Y)
(COND ((EQ X 0)
0)
((EQ X 1)
Y)
(T (RunAlg (QUOTE Add)
Y
(RunAlg (QUOTE Multiply)
(SUB1 X)
Y]
UnitizedAlg [LAMBDA (X Y)
(COND ((EQ X 0)
0)
((EQ X 1)
Y)
(T (RunAlg (QUOTE Add)
Y
(RunAlg (QUOTE Multiply)
(SUB1 X)
Y]
IterativeAlg [LAMBDA (X Y)
(for i from 1 to X sum Y]
Arity 2
Domain (NNumber NNumber)
Range (NNumber)
ElimSlots (Applics))
(PUTPROPS NNumber Worth 500
IsA (Set MathConcept MathObj)
Specializations (PrimeNum PerfNum PerfSquare OddNum EvenNum)
Generator ((0)
(ADD1)
(old))
FastDefn FIXP
InDomainOf (DivisorsOf Multiply Add Successor Square IEQP ILEQ IGEQ ILESSP IGREATERP)
IsRangeOf (Multiply Add Successor)
ElimSlots (Examples))
(PUTPROPS NonExamples Worth 600
IsA (Slot CriterialSlot)
DataType Unit
DoubleCheck T
DontCopy T)
(PUTPROPS NumOp Generalizations (MathConcept Op MathOp)
Worth 500
IsA (Set)
Abbrev (Numeric Operations)
Examples (DivisorsOf Square Multiply Add Successor))
(PUTPROPS OddNum Generalizations (NNumber)
Worth 800
UnitizedDefn [LAMBDA (n)
(NOT (RunAlg Divides 2 n]
IsA (Set MathConcept MathObj)
FastDefn [LAMBDA (n)
(EQ 1 (REMAINDER n 2]
ElimSlots (Examples))
(PUTPROPS Op Worth 500
IsA (Set)
Specializations (MathOp Heuristic SetOp UnitOp NumOp Pred MathPred HindSightRule)
Examples (H9 H8 H5 H1 H6 H3 H4 H7 Add Square Successor Multiply DivisorsOf H10 H11 RandomChoose RandomSubset
GoodChoose BestChoose BestSubset GoodSubset EQUAL IEQP EQ ILEQ IGEQ ILESSP IGREATERP AND OR
TheSecondOf TheFirstOf H3-20 H2 H5-23 H5-47 H12 HAvoid H1-5 HAvoid2 HAvoid3 H13 H14))
(PUTPROPS PerfNum Generalizations (NNumber)
Worth 800
UnitizedDefn [LAMBDA (n)
(EQ (RunAlg (QUOTE Double)
n)
(APPLY (QUOTE PLUS)
(RunAlg (QUOTE DivisorsOf)
n]
IsA (Set MathConcept MathObj)
IterativeDefn [LAMBDA (n)
(EQ (SUB1 n)
(for i from 2 to (SUB1 n)
sum
(COND ((Divides i n)
i)
(T 0]
ElimSlots NIL
Examples (6 28)
NonExamples (0 1))
(PUTPROPS PerfSquare Generalizations (NNumber)
Worth 950
IsRangeOf (Square)
IsA (Set MathConcept MathObj)
ElimSlots (Examples))
(PUTPROPS Pred Generalizations (Op)
Worth 500
IsA (Set)
Abbrev (Boolean predicates)
Specializations (MathPred)
Examples (EQUAL IEQP EQ ILEQ IGEQ ILESSP IGREATERP AND OR TheSecondOf TheFirstOf))
(PUTPROPS PrimeNum Generalizations (NNumber)
Worth 950
UnitizedDefn [LAMBDA (n)
(RunDefn (RunAlg (QUOTE DivisorsOf)
n)
(QUOTE Doubleton]
IsA (Set MathConcept MathObj)
IterativeDefn [LAMBDA (n)
(EQ 0 (for i from 2 to (SUB1 n)
sum
(COND ((Divides i n)
i)
(T 0]
FastDefn [LAMBDA (n)
(for i from 2 to (ISQRT n)
never
(Divides i n]
NonExamples (0 1)
ElimSlots (Examples))
(PUTPROPS ProtoConjec Worth 802
IsA (Conjecture))
(PUTPROPS RandomChoose Worth 503
IsA (MathConcept MathOp Op SetOp)
FastAlg [LAMBDA (L)
(CAR (NTH L (RAND 1 (LENGTH L]
Domain (Set)
Range (Anything)
Specializations (GoodChoose BestChoose)
ElimSlots (Applics))
(PUTPROPS RandomSubset Worth 510
IsA (MathConcept MathOp Op SetOp)
FastAlg [LAMBDA (L)
(SUBSET L (QUOTE RandomP]
Domain (Set)
Range (Set)
Specializations (BestSubset GoodSubset)
ElimSlots (Applics))
(PUTPROPS Range Worth 300
IsA (Slot NonCriterialSlot)
DataType Unit
Inverse (IsRangeOf))
(PUTPROPS RecursiveAlg SuperSlots (Alg)
IsA (Slot CriterialSlot)
Worth 600
DataType LispFn)
(PUTPROPS RecursiveDefn SuperSlots (Defn)
Worth 600
IsA (Slot CriterialSlot)
DataType LispPred)
(PUTPROPS ReprConcept Generalizations (Anything)
Worth 500
Examples (Slot Unit CriterialSlot NonCriterialSlot)
IsA (Set))
(PUTPROPS Set Worth 500
IsA (Set MathConcept MathObj)
Generator ((NIL NIL)
(CONS CONS)
(old old2))
Examples (Set Heuristic Anything MathConcept Slot MathObj NNumber Unit PrimeNum Conjecture ReprConcept EvenNum
Task MathOp OddNum PerfNum PerfSquare Op SetOfNumbers SetOp UnitOp NumOp CriterialSlot Pred
MathPred Bit NonCriterialSlot HindSightRule)
FastDefn [LAMBDA (s)
(OR (EQ s NIL)
(NoRepeatsIn s]
RecursiveDefn [LAMBDA (s)
(COND ((NLISTP s)
(EQ s NIL))
(T (AND (NOT (MEMBER (CAR s)
(CDR s)))
(RunDefn (QUOTE Set)
(CDR s]
InDomainOf (RandomChoose RandomSubset GoodChoose BestChoose BestSubset GoodSubset)
IsRangeOf (RandomSubset BestSubset GoodSubset))
(PUTPROPS SetOfNumbers IsRangeOf (DivisorsOf)
IsA (Set MathConcept MathObj)
Worth 500
UnitizedDefn [LAMBDA (s)
(AND (RunDefn (QUOTE Set)
s)
(EVERY s (FUNCTION (LAMBDA (n)
(RunDefn NNumber n]
FastDefn [LAMBDA (s)
(AND (RunDefn (QUOTE Set)
s)
(EVERY s (QUOTE NUMBERP]
ElimSlots (Examples))
(PUTPROPS SetOp Generalizations (MathConcept Op MathOp)
Worth 500
IsA (Set)
Abbrev (Set Operations)
Specializations (UnitOp)
Examples (RandomChoose RandomSubset GoodChoose BestChoose BestSubset GoodSubset))
(PUTPROPS SibSlots Worth 300
IsA (Slot NonCriterialSlot)
Inverse (SibSlots)
DataType Slot
DoubleCheck T)
(PUTPROPS Slot IsA (Set ReprConcept)
Worth 513
Examples (IfAboutToWorkOnTask Applics IfFinishedWorkingOnTask IsA IfTrulyRelevant SubSlots IfParts
IfPotentiallyRelevant Examples DataType English Worth Inverse Creditors
Generalizations Specializations ThenAddToAgenda ThenCompute ThenConjecture Abbrev
ThenDefineNewConcepts ThenModifySlots ThenPrintToUser ThenParts SuperSlots
IfTaskParts Format DontCopy DoubleCheck Generator IfWorkingOnTask IsRangeOf
ToDelete1 Alg FastDefn RecursiveDefn UnitizedDefn FastAlg IterativeAlg
RecursiveAlg UnitizedAlg IterativeDefn ToDelete ApplicGenerator Arity NonExamples
CompiledDefn ElimSlots InDomainOf Domain Range IndirectApplics DirectApplics Defn
SibSlots Transpose ThenDeleteOldConcepts English-4)
Specializations (CriterialSlot NonCriterialSlot))
(PUTPROPS Specializations Worth 313
IsA (Slot NonCriterialSlot)
SubSlots (SubSlots)
Inverse (Generalizations)
DataType Unit
DoubleCheck T)
(PUTPROPS Square Worth 500
UnitizedAlg [LAMBDA (n)
(RunAlg (QUOTE Multiply)
n n]
IsA (MathConcept MathOp Op NumOp)
FastAlg [LAMBDA (n)
(ITIMES n n]
Domain (NNumber)
Range (PerfSquare)
ElimSlots (Applics))
(PUTPROPS SubSlots Worth 300
IsA (Slot NonCriterialSlot)
Inverse (SuperSlots)
SuperSlots (Specializations)
DataType Slot
DoubleCheck T)
(PUTPROPS Successor Worth 500
IsA (MathConcept MathOp Op NumOp)
FastAlg [LAMBDA (X Y)
(ADD1 X Y]
Domain (NNumber)
Range (NNumber)
ElimSlots (Applics))
(PUTPROPS SuperSlots Worth 300
Inverse (SubSlots)
IsA (Slot NonCriterialSlot)
SuperSlots (Generalizations)
DataType Slot
DoubleCheck T)
(PUTPROPS Task Worth 500
Format (priority-value unit-name slot-name reasons misc-args)
IsA (Set))
(PUTPROPS ThenAddToAgenda Worth 600
IsA (Slot CriterialSlot)
SuperSlots (ThenParts)
DataType LispFn)
(PUTPROPS ThenCompute Worth 600
IsA (Slot CriterialSlot)
SuperSlots (ThenParts)
DataType LispFn)
(PUTPROPS ThenConjecture Worth 600
IsA (Slot CriterialSlot)
SuperSlots (ThenParts)
DataType LispFn)
(PUTPROPS ThenDefineNewConcepts Worth 600
IsA (Slot CriterialSlot)
SuperSlots (ThenParts)
DataType LispFn)
(PUTPROPS ThenModifySlots Worth 600
IsA (Slot CriterialSlot)
SuperSlots (ThenParts)
DataType LispFn)
(PUTPROPS ThenParts Worth 600
IsA (Slot CriterialSlot)
SubSlots (ThenCompute ThenModifySlots ThenConjecture ThenDefineNewConcepts ThenDeleteOldConcepts
ThenAddToAgenda ThenPrintToUser)
DataType LispFn)
(PUTPROPS ThenPrintToUser Worth 600
IsA (Slot CriterialSlot)
SuperSlots (ThenParts)
DataType LispFn)
(PUTPROPS ToDelete Worth 600
IsA (Slot CriterialSlot)
DataType LispFn)
(PUTPROPS ToDelete1 Worth 600
IsA (Slot CriterialSlot)
DataType LispFn)
(PUTPROPS Transpose Worth 300
IsA (Slot NonCriterialSlot)
DataType Unit
DoubleCheck T
Inverse (Transpose))
(PUTPROPS Unit IsA (Set ReprConcept)
Worth 500)
(PUTPROPS UnitOp Generalizations (MathConcept Op MathOp SetOp)
Worth 500
IsA (Set)
Abbrev (Operations performable upon a set of units))
(PUTPROPS UnitizedAlg SuperSlots (Alg)
IsA (Slot CriterialSlot)
Worth 600
DataType LispFn)
(PUTPROPS UnitizedDefn SuperSlots (Defn)
Worth 600
IsA (Slot CriterialSlot)
DataType LispPred)
(PUTPROPS Worth Worth 302
IsA (Slot NonCriterialSlot)
DataType Number)
(PUTPROPS los1 Worth 100)
(PUTPROPS los2 Worth 100)
(PUTPROPS los3 Worth 100)
(PUTPROPS los4 Worth 100)
(PUTPROPS los5 Worth 100)
(PUTPROPS los6 Worth 100)
(PUTPROPS los7 Worth 100)
(PUTPROPS win1 Worth 904)
[ADVISE (QUOTE EDITP)
(QUOTE BEFORE)
(QUOTE (OR (STKPOS (QUOTE EU))
(PRIN1 "
WARNING: ARE YOU SURE YOU REALLY DON'T MEAN 'EU' ??? !!! "]
(ADVISE (QUOTE MAKEFILE)
(QUOTE BEFORE)
(QUOTE (CheckElim)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS AbortTask? Agenda AreUnits CRLF CSlot CSlotSibs CTask Conjectures CreditTo Creditors CurPri CurReasons
CurSlot CurSup CurUnit DeletedUnits ESYSPROPS EditpTemp GCredit GSlot HaveGenl HaveSpec HeuristicAgenda Interp
LastEdited MapCycleTime MinPri NUnitSlots NeedGenl NeedSpec NewU NewUnit NewUnits NewValue NotForReal OldValue PosCred
RArrow SYSPROPS SlotToChange SlotsToChange SlotsToElimInitially Slots TTY TaskNum UDiff Units UnusedSlots UsedSlots
UserImpatience Verbosity WarnSlots conjec cprintmp)
)
(SETQ SYSPROPS (UNION ESYSPROPS SYSPROPS))
(InitializeEurisko)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA EU)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA CPRIN1)
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (7747 55596 (APPLYEVAL 7759 . 7886) (AddInv 7890 . 8190) (AddPropL 8194 . 8449) (Alg 8453 . 8664) (ApplicArgs 8668 .
8784) (ApplicGenArgs 8788 . 8909) (ApplicGenBuild 8913 . 9034) (ApplicGenInit 9038 . 9157) (Apply-to-u 9161 . 9282) (ApplyRule
9286 . 9767) (Average 9771 . 9883) (AverageWorths 9887 . 10026) (BestChoose 10030 . 10193) (BestSubset 10197 . 10371) (CPRIN1
10375 . 10627) (Certainty 10631 . 10924) (Check2AfterEditp 10928 . 11224) (CheckAfterEditp 11228 . 11610) (CheckElim 11614 . 11826
) (CheckTheValues 11830 . 12116) (Comp 12120 . 12412) (CreateUnit 12416 . 13133) (CurSup 13137 . 13232) (CycleThruAgenda 13236 .
13581) (Date2 13585 . 13901) (DecrementCreditAssignment 13905 . 14028) (DefineSlot 14032 . 14573) (Defn 14577 . 14791) (
DirectApplics 14795 . 14968) (Divides 14972 . 15100) (DreplaceGet 15104 . 15370) (DwimUnionProp 15374 . 16036) (EU 16040 . 16919)
(Eurisko 16923 . 17366) (ExtractInput 17370 . 17488) (ExtractOutput 17492 . 17612) (ExtractPriority 17616 . 17712) (ExtractReasons
17716 . 17814) (ExtractSlotName 17818 . 17916) (ExtractUnitName 17920 . 18019) (Flatten 18023 . 18195) (FractionOf 18199 . 18466)
(GenArgs 18470 . 18585) (GenBuild 18589 . 18704) (GenInit 18708 . 18821) (Generalizations 18825 . 19108) (Generalize1LispFn 19112
. 19393) (Generalize1LispPred 19397 . 19680) (GeneralizeIOPair 19684 . 19817) (GeneralizeLispFn 19821 . 20378) (
GeneralizeLispPred 20382 . 20945) (GoodChoose 20949 . 21119) (GoodSubset 21123 . 21260) (Half 21264 . 21382) (HasHighWorth 21386 .
21545) (ISQRT 21549 . 21666) (IndirectApplics 21670 . 21848) (InitialElimSlots 21852 . 22110) (InitializeCreditAssignment 22114 .
22226) (InitializeEurisko 22230 . 24334) (InsideOf 24338 . 24555) (Instances 24559 . 24797) (Interp1 24801 . 25153) (Interp2
25157 . 26109) (Interrupts 26113 . 26650) (IsAKindOf 26654 . 26777) (KillSlot 26781 . 27481) (KillUnit 27485 . 27750) (KnownApplic
27754 . 27915) (LessWorth 27919 . 28138) (ListifyIfNec 28142 . 28252) (ListsStarting 28256 . 28525) (ListsStartingAux 28529 .
28801) (MAPAPPEND 28805 . 28992) (MAXIMUM 28996 . 29737) (Map&Print 29741 . 29906) (MapApplics 29910 . 31113) (MapExamples 31117 .
32293) (MapUnion 32297 . 32581) (MergeProps 32585 . 33294) (MergeTasks 33298 . 34476) (NU 34480 . 35455) (NUnitp 35459 . 35549) (
NearnessTo 35553 . 35756) (NewNam 35760 . 36029) (NoRepeatsIn 36033 . 36199) (OrderTasks 36203 . 36349) (Percentify 36353 . 36520)
(PunishSeverely 36524 . 36699) (Quoted 36703 . 36829) (REM1PROP 36833 . 37088) (RandomChoose 37092 . 37204) (RandomP 37208 .
37301) (RandomSubset 37305 . 37441) (RandomSubst 37445 . 37717) (RandomSubst* 37721 . 38003) (ResetPri 38007 . 38350) (RunAlg
38354 . 38555) (RunDefn 38559 . 38779) (SOME1 38783 . 38975) (SOS 38979 . 39357) (SQUARE 39361 . 39448) (START 39452 . 40140) (
SelfIntersect 40144 . 40245) (SetDiff 40249 . 40456) (SetIntersect 40460 . 40616) (SibSlots 40620 . 40776) (SlotNames 40780 .
40934) (SlotSubst 40938 . 41173) (Slotp 41177 . 41326) (SomeUneliminated 41330 . 41591) (SortByWorths 41595 . 41731) (
Specializations 41735 . 42018) (Specialize1LispExpr 42022 . 42852) (Specialize1LispFn 42856 . 42997) (Specialize1LispPred 43001 .
43144) (SpecializeBit 43148 . 43238) (SpecializeCompiledLispCode 43242 . 43369) (SpecializeDataType 43373 . 43732) (
SpecializeIOPair 43736 . 44072) (SpecializeLispFn 44076 . 44863) (SpecializeLispPred 44867 . 45660) (SpecializeList 45664 . 46051)
(SpecializeNIL 46055 . 46217) (SpecializeNumber 46221 . 46630) (SpecializeSlot 46634 . 46960) (SpecializeText 46964 . 47351) (
SpecializeUnit 47355 . 47681) (StrongUnsaveDef 47685 . 47892) (TakingTooLong 47896 . 48291) (TheFirstOf 48295 . 48406) (
TheSecondOf 48410 . 48522) (TinyReward 48526 . 48674) (TrueIfItExists 48678 . 49426) (UnGet 49430 . 50572) (UnionProp 50576 .
50732) (Unitp 50736 . 50979) (WaxOn 50983 . 51319) (WholeTask 51323 . 51699) (WorkOnTask 51703 . 53477) (WorkOnUnit 53481 . 54094)
(WorthWorkingOn 54098 . 54251) (XeqIfItExists 54255 . 55356) (YesNo 55360 . 55593)))))
STOP